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
28 // ////////////////////////////////////////////////////////////////////////// //
29 type
31 public
37 public
40 public
46 // ////////////////////////////////////////////////////////////////////////// //
47 type
57 // this is base type for all scalars (and arrays)
59 public
60 type
61 TType = (TBool, TChar, TByte, TUByte, TShort, TUShort, TInt, TUInt, TString, TPoint, TSize, TColor, TList, TTrigData);
62 // TPoint: pair of Integers
63 // TSize: pair of UShorts
64 // TList: actually, array of records
65 // TTrigData: array of mMaxDim bytes, but internally a record (mRecRef)
66 // in binary: arrays of chars are pascal shortstrings (with counter in the first byte)
68 private
69 type
72 private
96 mAsMonsterId: Boolean; // special hack for triggers: monster record number+1 in binary (so 0 means "none")
97 // default value
104 mEBSType: TObject; // either TDynRecord or TDynEBS; nil means "simple type"; nil for `TTrigData` too
106 // for binary parser
109 // for userdata
113 // for pasgen
116 private
119 procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef`
137 protected
138 // returns `true` for duplicate record id
142 public
143 // get string name for the given type
146 public
152 // clone this field; register all list records in `registerIn`
153 // "registration" is required to manage record lifetime; use header record if in doubt
154 // owner will be set to `newOwner`, if it is not `nil`, or to `owner`
155 // for lists, cloning will clone all list members
158 // compare field values (including trigdata)
159 // WARNING: won't work for lists
162 // parse string value to appropriate type and set new field value
165 // supports `for rec in field do` (for lists)
180 public
181 // text parser and writer
185 // binary parser and writer (DO NOT USE!)
189 public
190 // the following functions are here only for 'mapgen'! DO NOT USE!
191 // build "alias name" for pascal code
194 public
200 property ival: Integer read mIVal; // integer value for int field (for speed), first field (x/w) for `TPoint` and `TSize`
209 property hasDefault: Boolean read mHasDefault; // `true` if this field has default value in mapdef
212 property ebstype: TObject read mEBSType; // reference type (nil, TDynRecord, TDynEBS); WARNING: don't modify type!
214 property recref: TDynRecord read mRecRef write setRecRef; // referenced record (actual one, you can modify it)
215 property recrefIndex: Integer read getRecRefIndex; // index of referenced record in header; -1: not found
216 // for record lists
219 property item[const aname: AnsiString]: TDynRecord read getListItem; default; // alas, FPC 3+ lost property overloading feature
220 // field value as Variant
226 public
227 // userdata (you can use these properties as you want to; they won't be written or read to files)
231 public
232 // the following properties are here only for 'mapgen'! DO NOT USE!
241 // record, either with actual values, or with type definitions
243 private
251 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
253 {$ENDIF}
257 mHeaderRec: TDynRecord; // for "value" records this is header record with data, for "type" records this is header type record
259 // for userdata
265 private
288 protected
291 function addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean; // `true`: duplicate record id
296 public
301 // clone this record; register all list records in `registerIn`
302 // "registration" is required to manage record lifetime; use header record if in doubt
303 // all fields are cloned too
306 // compare records (values of all fields, including trigdata)
307 // WARNING: won't work for records with list fields
310 // find field with `TriggerType` type
313 // number of records of the given instance
316 // only for headers: create new record with the given type
317 // will return cloned record ready for use, or `nil` on unknown type name
318 // `aid` must not be empty, and must be unique
321 // remove record with the given type and id
322 // return `true` if record was successfully found and removed
323 // this will do all necessary recref cleanup too
324 // WARNING: not tested yet
327 //TODO:
328 // [.] API to create triggers
329 // [.] API to properly remove triggers (remove trigdata)
330 // [.] check if `removeTypedRecord()` does the right thing with inline records
331 // [.] for fields: assigning `recref` should remove previously assigned inline record (record without id)
332 // [.] other API i forgot
334 public
335 // text parser
336 // `beginEaten`: `true` if "{" was eaten
339 // text writer
340 // `putHeader`: `true` to write complete header, otherwise only "{...}"
343 // binary parser and writer (DO NOT USE!)
345 procedure writeBinTo (var hasLostData: Boolean; st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
347 public
351 property has[const aname: AnsiString]: Boolean read hasByName; // do we have field with the given name?
353 property field[const aname: AnsiString]: TDynField read getFieldByName; default; // get field by name
356 property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig; // can this "TriggerData" be used for the trigger with the given type?
357 property forTrigCount: Integer read getForTrigCount; // number of trigger type names for "TriggerData"
358 property forTrigAt[idx: Integer]: AnsiString read getForTrigAt; // trigger type name at the given index for "TriggerData"
359 property headerRec: TDynRecord read mHeaderRec; // get header record for this one (header contains all other records, enums, bitsets, etc.)
365 public
366 // user fields; user can add arbitrary custom fields
367 // by default, any user field will be marked as "internal"
368 // note: you can use this to manipulate non-user fields too
371 public
372 // userdata (you can use these properties as you want to; they won't be written or read to files)
378 // bitset/enum definition
380 private
391 private
403 public
407 // find name for the given value
408 // return empty string if not found
411 public
423 // parsed "mapdef.txt"
425 public
430 private
444 // creates new header record
447 // creates new header record
450 public
458 public
459 // parse text or binary map, return new header record
460 // WARNING! stream must be seekable
463 // returns `true` if the given stream can be a map file
464 // stream position is 0 on return
465 // WARNING! stream must be seekable
468 public
469 // the following functions are here only for 'mapgen'! DO NOT USE!
472 public
474 // for record types
478 // for enum/bitset types
482 // for trigtypes
489 {$IF DEFINED(D2D_DYNREC_PROFILER)}
491 {$ENDIF}
493 var
496 implementation
498 {$IF DEFINED(D2D_DYNREC_PROFILER)}
499 uses
500 xprofiler;
501 {$ENDIF}
504 // ////////////////////////////////////////////////////////////////////////// //
508 // ////////////////////////////////////////////////////////////////////////// //
510 begin
515 begin
520 // ////////////////////////////////////////////////////////////////////////// //
522 begin
523 if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
527 constructor TDynParseException.CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
528 begin
529 if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
534 // ////////////////////////////////////////////////////////////////////////// //
536 begin
537 //result := TListEnumerator.Create(mRVal);
538 if (mRVal <> nil) then result := mRVal.GetEnumerator else result := TDynRecList.TEnumerator.Create(nil, 0);
542 // ////////////////////////////////////////////////////////////////////////// //
544 begin
552 begin
560 begin
568 begin
592 else
596 begin
633 begin
640 begin
684 var
686 begin
700 begin
735 var
738 begin
740 begin
741 if firstUp then result := UpCase1251(mAlias[1])+Copy(mAlias, 2, Length(mAlias)-1) else result := mAlias;
742 end
743 else
744 begin
748 begin
758 var
760 begin
762 TEBS.TNone: raise TDynRecException.CreateFmt('cannot set refrec for non-reference field ''%s''', [mName]);
764 begin
766 begin
768 if (trc = nil) then raise TDynRecException.CreateFmt('cannot set refrec for field ''%s'' (type conflict: improperly initialized field)', [mName]);
769 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]);
773 exit;
775 TEBS.TEnum: raise TDynRecException.CreateFmt('cannot set refrec for enum field ''%s''', [mName]);
776 TEBS.TBitSet: raise TDynRecException.CreateFmt('cannot set refrec for bitset field ''%s''', [mName]);
783 begin
800 else result := Unassigned; raise TDynRecException.Create('ketmar forgot to handle some field type');
807 begin
831 else
835 begin
846 varString:
848 begin
850 end
851 else
852 begin
856 varBoolean:
868 else
873 varByte,
874 varWord,
875 varShortInt,
876 varSmallint,
877 varInteger:
879 varInt64:
882 else
884 varLongWord:
885 if (val > LongWord($7FFFFFFF)) then raise TDynRecException.Create('cannot convert longword variant to field value')
895 // won't work for lists
897 begin
914 result := ((mIVal = fld.mIVal) and (mIVal2 = fld.mIVal2) and (mIVal3 = fld.mIVal3) and (mIVal4 = fld.mIVal4));
917 begin
927 var
929 begin
931 try
933 finally
939 function TDynField.getRed (): Integer; inline; begin result := mIVal; if (result < 0) then result := 0 else if (result > 255) then result := 255; end;
940 procedure TDynField.setRed (v: Integer); inline; begin if (v < 0) then v := 0 else if (v > 255) then v := 255; mIVal := v; end;
942 function TDynField.getGreen (): Integer; inline; begin result := mIVal2; if (result < 0) then result := 0 else if (result > 255) then result := 255; end;
943 procedure TDynField.setGreen (v: Integer); inline; begin if (v < 0) then v := 0 else if (v > 255) then v := 255; mIVal2 := v; end;
945 function TDynField.getBlue (): Integer; inline; begin result := mIVal3; if (result < 0) then result := 0 else if (result > 255) then result := 255; end;
946 procedure TDynField.setBlue (v: Integer); inline; begin if (v < 0) then v := 0 else if (v > 255) then v := 255; mIVal3 := v; end;
948 function TDynField.getAlpha (): Integer; inline; begin result := mIVal4; if (result < 0) then result := 0 else if (result > 255) then result := 255; end;
949 procedure TDynField.setAlpha (v: Integer); inline; begin if (v < 0) then v := 0 else if (v > 255) then v := 255; mIVal4 := v; end;
953 var
959 begin
961 begin
968 end
969 else
970 begin
978 try
981 //if (mType = TType.TColor) then writeln('4=[', mIVal4, ']');
988 finally
1002 // default value should be parsed
1004 begin
1007 begin
1009 raise TDynRecException.CreateFmt('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mTypeName]);
1017 //if (mType = TType.TColor) then writeln('4=[', mDefIVal4, ']');
1022 // default value should be parsed
1024 begin
1030 TType.TColor: result := (mIVal = mDefIVal2) and (mIVal2 = mDefIVal2) and (mIVal3 = mDefIVal3) and (mIVal4 = mDefIVal4);
1038 begin
1044 begin
1045 if (mRVal <> nil) and (idx >= 0) and (idx < mRVal.count) then result := mRVal[idx] else result := nil;
1050 var
1052 begin
1058 begin
1061 begin
1069 var
1071 begin
1074 begin
1077 // fix hash and list
1079 begin
1089 begin
1111 begin
1121 TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
1126 begin
1127 if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
1128 else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
1136 var
1156 begin
1186 begin
1188 begin
1189 if (Length(fldtype) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate type definition for field ''%s''', [fldname]);
1194 begin
1196 // arbitrary limits
1197 if (lmaxdim < 1) or (lmaxdim > 32768) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' array size', [fldname]);
1199 end;
1200 continue;
1204 begin
1205 if (Length(xalias) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate alias definition for field ''%s''', [fldname]);
1207 continue;
1211 begin
1212 if (Length(atip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for field ''%s''', [fldname]);
1214 continue;
1218 begin
1219 if (Length(ahelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for field ''%s''', [fldname]);
1221 continue;
1225 begin
1226 if (fldofs >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' offset', [fldname]);
1228 if (fldofs < 0) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' offset', [fldname]);
1229 continue;
1233 begin
1240 continue;
1241 end;
1244 begin
1246 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1248 continue;
1252 begin
1254 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1257 continue;
1261 begin
1262 if hasdefStr or hasdefInt or hasdefId then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has duplicate default', [fldname]);
1265 begin
1270 begin
1275 begin
1280 begin
1286 begin
1292 else
1295 continue;
1299 begin
1301 continue;
1305 begin
1307 continue;
1310 // record type, no special modifiers
1311 if (pr.tokType <> pr.TTId) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has something unexpected in definition', [fldname]);
1313 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1320 // create field
1336 else
1337 begin
1338 // record types defaults to int
1340 begin
1342 end
1343 else
1344 begin
1345 if (Length(fldtype) = 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has no type', [fldname])
1346 else raise TDynParseException.CreateFmt(pr, 'field ''%s'' has invalid type ''%s''', [fldname, fldtype]);
1350 // check for valid arrays
1351 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]);
1353 // check for valid trigdata or record type
1355 begin
1356 // trigdata
1357 if (lmaxdim < 1) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot be non-array', [fldname, 'trigdata']);
1358 if (Length(fldrecname) > 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot have another type', [fldname, 'trigdata']);
1360 end
1362 begin
1363 // record
1364 if not (mType in [TType.TByte, TType.TUByte, TType.TShort, TType.TUShort, TType.TInt, TType.TUInt]) then
1365 begin
1366 raise TDynParseException.CreateFmt(pr, 'field ''%s'' of record type ''%s'' cannot have type ''%s''', [fldname, fldrecname, fldtype]);
1370 // setup default value
1374 begin
1377 else if (mType = TType.TColor) then self.mDefUnparsed := Format('(%d %d %d %d)', [defint, defint2, defint3, defint4])
1395 end;
1399 begin
1406 var
1412 begin
1416 begin
1418 begin
1419 // this must be triggerdata
1421 begin
1422 raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1424 // write triggerdata
1426 if (buf = nil) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1427 try
1430 begin
1435 finally
1439 exit;
1441 // record reference
1449 else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1451 // find record number
1453 begin
1455 if (f < 0) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]);
1457 if (f > maxv) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]);
1458 end
1459 else
1460 begin
1467 else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1469 exit;
1478 begin
1480 begin
1482 end
1483 else
1484 begin
1487 exit;
1490 begin
1491 if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1493 begin
1494 if (Length(mSVal) <> 1) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1496 end
1497 else
1498 begin
1499 if (Length(mSVal) > mMaxDim) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1504 exit;
1508 begin
1509 // triggerdata array was processed earlier
1510 if (mMaxDim >= 0) then TDynRecException.CreateFmt('byte array in field ''%s'' cannot be written', [mName]);
1512 exit;
1516 begin
1517 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('short array in field ''%s'' cannot be written', [mName]);
1519 exit;
1523 begin
1524 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('int array in field ''%s'' cannot be written', [mName]);
1526 exit;
1529 begin
1533 begin
1534 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
1537 exit;
1540 begin
1541 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
1544 exit;
1547 begin
1548 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('color array in field ''%s'' cannot be written', [mName]);
1552 //writeInt(st, Byte(mIVal4)); // the only place we have RGB in binary map is effect trigger, and it has no alpha
1554 exit;
1566 var
1570 begin
1576 begin
1578 begin
1580 end
1582 begin
1584 end
1585 else
1586 begin
1590 exit;
1593 begin
1594 //def := mOwner.mOwner;
1595 //es := def.ebsType[mEBSTypeName];
1598 if (es = nil) or (not es.mIsEnum) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1600 begin
1602 begin
1605 exit;
1608 raise TDynRecException.CreateFmt('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]);
1611 begin
1612 //def := mOwner.mOwner;
1613 //es := def.ebsType[mEBSTypeName];
1616 if (es = nil) or es.mIsEnum then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1617 // none?
1619 begin
1621 begin
1623 begin
1626 exit;
1629 raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]);
1631 // not none
1635 begin
1637 begin
1640 begin
1642 begin
1646 break;
1649 if not found then raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]);
1654 exit;
1661 begin
1663 exit;
1666 begin
1667 if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1670 exit;
1678 begin
1680 exit;
1683 begin
1686 exit;
1690 begin
1692 exit;
1695 begin
1698 exit;
1701 begin
1703 exit;
1706 begin
1708 exit;
1717 var
1724 begin
1728 begin
1729 // this must be triggerdata
1731 begin
1734 // find trigger definition
1736 if (tfld = nil) then raise TDynRecException.CreateFmt('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mTypeName]);
1738 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]);
1741 // on error, it will be freed by memowner
1745 exit;
1746 end
1747 else
1748 begin
1749 // not a trigger data
1757 else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
1763 exit;
1767 begin
1776 else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
1780 if (es = nil) or (es.mIsEnum <> (mEBS = TEBS.TEnum)) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1782 // build enum/bitfield values
1784 begin
1786 if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
1787 end
1788 else
1789 begin
1790 // special for 'none'
1792 begin
1794 if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
1795 end
1796 else
1797 begin
1801 begin
1803 begin
1805 if (Length(s) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]);
1813 //writeln('ebs <', es.mName, '>: ', mSVal);
1815 exit;
1822 begin
1828 exit;
1831 begin
1833 begin
1835 end
1836 else
1837 begin
1840 try
1845 begin
1850 finally
1855 exit;
1864 begin
1866 exit;
1869 begin
1873 exit;
1876 begin
1880 exit;
1883 begin
1887 //mIVal4 := readByte(st); // the only place we have RGB in binary map is effect trigger, and it has no alpha
1890 exit;
1893 begin
1895 exit;
1898 begin
1900 exit;
1911 begin
1913 if (mIVal < min) or (mIVal > max) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
1917 var
1923 begin
1926 // if this field should contain struct, convert type and parse struct
1930 begin
1931 // ugly hack. sorry.
1933 begin
1936 begin
1937 // '{}'
1939 end
1940 else
1941 begin
1943 // find trigger definition
1945 if (tfld = nil) then raise TDynParseException.CreateFmt(pr, 'triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mTypeName]);
1947 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]);
1950 //writeln(rc.definition);
1951 // on error, it will be freed by memowner
1957 exit;
1959 // other record types
1961 begin
1963 begin
1965 end
1966 else
1967 begin
1970 begin
1972 end
1973 else
1974 begin
1982 exit;
1983 end
1985 begin
1986 //rec := mOwner.mOwner.recType[mEBSTypeName]; // find in mapdef
1989 if (rec = nil) then raise TDynParseException.CreateFmt(pr, 'record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1996 begin
1997 raise TDynParseException.CreateFmt(pr, 'duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mTypeName]);
2000 exit;
2005 begin
2006 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
2009 if (es = nil) or (not es.mIsEnum) then raise TDynParseException.CreateFmt(pr, 'record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
2011 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]);
2014 //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
2017 exit;
2020 begin
2021 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
2024 if (es = nil) or es.mIsEnum then raise TDynParseException.CreateFmt(pr, 'record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
2027 begin
2029 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]);
2033 if mBitSetUnique then raise TDynParseException.CreateFmt(pr, 'record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]);
2038 exit;
2045 begin
2051 exit;
2054 begin
2055 if (mMaxDim = 0) then raise TDynParseException.CreateFmt(pr, 'invalid string size definition for field ''%s''', [mName]);
2058 begin
2059 // single char
2060 if (Length(mSVal) <> 1) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
2063 end
2064 else
2065 begin
2066 // string
2067 if (Length(mSVal) > mMaxDim) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
2071 exit;
2074 begin
2077 exit;
2080 begin
2083 exit;
2086 begin
2089 exit;
2092 begin
2095 exit;
2098 begin
2101 exit;
2104 begin
2107 exit;
2110 begin
2114 exit;
2118 begin
2122 begin
2123 if (mIVal < 0) or (mIVal > 65535) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2127 begin
2128 if (mIVal2 < 0) or (mIVal2 > 65535) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2133 exit;
2136 begin
2139 if (mIVal < 0) or (mIVal > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2141 if (mIVal2 < 0) or (mIVal2 > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2143 if (mIVal3 < 0) or (mIVal3 > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2145 begin
2147 if (mIVal4 < 0) or (mIVal4 > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2148 end
2149 else
2150 begin
2156 exit;
2159 begin
2161 exit;
2164 begin
2166 exit;
2174 // ////////////////////////////////////////////////////////////////////////// //
2176 begin
2177 if (pr = nil) then raise TDynParseException.Create(pr, 'cannot create record type without type definition');
2182 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2184 {$ENDIF}
2196 begin
2200 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2202 {$ENDIF}
2213 var
2216 begin
2218 begin
2220 begin
2222 begin
2223 //writeln(formatstrf('freeing: 0x%08x; name=%s; id=%s', [Pointer(rec), rec.mName, rec.mId]));
2234 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2237 {$ENDIF}
2247 begin
2249 begin
2257 begin
2260 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2262 {$ENDIF}
2266 function TDynRecord.addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
2267 begin
2270 {$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
2272 {$ENDIF}
2274 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2276 {$ENDIF}
2281 begin
2282 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2284 {$ELSE}
2287 begin
2292 {$ENDIF}
2297 begin
2303 var
2305 begin
2312 begin
2318 begin
2324 begin
2330 var
2332 begin
2340 begin
2346 begin
2352 var
2355 begin
2369 begin
2380 var
2383 begin
2386 // find record data
2389 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2390 // find by id
2392 begin
2395 // alas
2399 function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
2400 var
2403 begin
2405 // find record data
2408 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2409 // find by ref
2411 begin
2413 begin
2417 // alas
2422 var
2424 begin
2425 // find record data
2428 begin
2429 // first record
2434 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2435 // append
2437 begin
2446 var
2448 begin
2454 begin
2462 var
2465 begin
2467 begin
2478 // number of records of the given instance
2480 var
2482 begin
2490 var
2493 begin
2494 if not mHeader then raise TDynRecException.Create('cannot create new records with non-header');
2495 if (Length(aid) = 0) then raise TDynRecException.CreateFmt('cannot create new record of type ''%s'' without id', [atypename]);
2498 // check if aid is unique
2500 if (fld <> nil) and (fld.getListItem(aid) <> nil) then raise TDynRecException.CreateFmt('cannot create record of type ''%s'' with duplicate id ''%s''', [atypename, aid]);
2509 var
2511 begin
2516 var
2518 begin
2524 // remove record with the given type and id
2525 // return `true` if record was successfully found and removed
2526 // this will do all necessary recref cleanup too
2528 var
2533 begin
2545 begin
2547 begin
2557 var
2559 begin
2566 var
2568 begin
2571 begin
2572 if (Length(aname) = 0) then raise TDynRecException.Create('cannot create nameless user field');
2577 end
2578 else
2579 begin
2586 var
2589 begin
2591 begin
2594 begin
2596 begin
2600 if isForTrig[tdn] then raise TDynParseException.CreateFmt(pr, 'duplicate trigdata ''%s'' trigtype ''%s''', [mTypeName, tdn]);
2604 end
2605 else
2606 begin
2612 end
2613 else
2614 begin
2617 begin
2620 begin
2621 if (mSize > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `size` in record ''%s''', [mTypeName]);
2623 if (mSize < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' size: %d', [mTypeName, mSize]);
2625 continue;
2628 begin
2629 if (mBinBlock >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `binblock` in record ''%s''', [mTypeName]);
2631 if (mBinBlock < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' binblock: %d', [mTypeName, mBinBlock]);
2632 continue;
2635 begin
2636 if (Length(mTip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for record ''%s''', [mTypeName]);
2638 continue;
2641 begin
2642 if (Length(mHelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate help definition for record ''%s''', [mTypeName]);
2644 continue;
2650 // load fields
2652 begin
2654 // append
2657 begin
2661 // done with field
2668 var
2670 begin
2672 begin
2673 // trigger data
2676 begin
2679 begin
2684 end
2685 else
2686 begin
2689 end
2690 else
2691 begin
2692 // record
2699 begin
2709 var
2721 var
2724 begin
2725 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2727 begin
2729 begin
2731 continue;
2737 begin
2739 begin
2740 DynWarningCB(formatstrf('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]), -1, -1);
2742 //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]);
2744 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2750 begin
2751 //if (fld.mName = 'ambient_color') then writeln('****', fld.mName);
2756 begin
2759 try
2761 begin
2762 // parse map file as sequence of blocks
2766 // parse blocks
2768 begin
2774 if (bsize < 0) or (bsize > $1fffffff) then raise TDynRecException.CreateFmt('block of type %d has invalid size %d', [btype, bsize]);
2775 if loaded[btype] then raise TDynRecException.CreateFmt('block of type %d already loaded', [btype]);
2777 // find record type for this block
2780 if (rect = nil) then raise TDynRecException.CreateFmt('block of type %d has no corresponding record', [btype]);
2781 //writeln('found type ''', rec.mName, ''' for block type ', btype);
2782 if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise TDynRecException.CreateFmt('block of type %d has invalid number of records', [btype]);
2783 // header?
2785 begin
2786 if (bsize <> mSize) then raise TDynRecException.CreateFmt('header block of type %d has invalid number of records', [btype]);
2791 end
2792 else
2793 begin
2794 // create list for this type
2799 begin
2803 begin
2810 //writeln('parsed ''', rec.mId, '''...');
2816 //st.position := st.position+bsize;
2818 // link fields
2820 begin
2824 exit;
2827 // read fields
2829 if (mSize < 1) then raise TDynRecException.CreateFmt('cannot read record of type ''%s'' with unknown size', [mTypeName]);
2833 begin
2836 if (fld.mBinOfs >= st.size) then raise TDynRecException.CreateFmt('record of type ''%s'' has invalid field ''%s''', [fld.mName]);
2838 //writeln('parsing ''', mName, '.', fld.mName, '''...');
2841 // fix default values
2843 begin
2847 finally
2854 procedure TDynRecord.writeBinTo (var hasLostData: Boolean; st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
2855 var
2863 begin
2865 begin
2866 if (mBinBlock < 1) then raise TDynRecException.Create('cannot write binary record without block number');
2869 end
2870 else
2871 begin
2874 try
2879 // write normal fields
2881 begin
2882 // record list?
2886 begin
2888 continue;
2890 if (fld.mBinOfs >= bufsz) then raise TDynRecException.Create('binary value offset is outside of the buffer');
2892 //writeln('writing field <', fld.mName, '>');
2896 // write block with normal fields
2898 begin
2899 //writeln('writing header...');
2900 // signature and version
2911 // write other blocks, if any
2913 begin
2914 // calculate blkmax
2917 begin
2918 // record list?
2920 begin
2928 // write blocks
2930 begin
2934 begin
2935 // record list?
2937 begin
2946 // flush block
2948 begin
2959 // write end marker
2964 finally
2972 var
2977 begin
2979 begin
2986 try
2988 begin
2989 // record list?
2991 begin
2994 begin
2997 begin
3000 begin
3003 begin
3013 end
3014 else
3015 begin
3022 continue;
3029 finally
3037 {$IF DEFINED(D2D_DYNREC_PROFILER)}
3038 var
3049 begin
3051 writeln('record cloning: ', profCloneRec div 1000, '.', profCloneRec mod 1000, ' milliseconds');
3052 writeln('findRecType : ', profFindRecType div 1000, '.', profFindRecType mod 1000, ' milliseconds');
3053 writeln('field[] : ', profFieldSearching div 1000, '.', profFieldSearching mod 1000, ' milliseconds');
3054 writeln('list dup check: ', profListDupChecking div 1000, '.', profListDupChecking mod 1000, ' milliseconds');
3055 writeln('addRecByType : ', profAddRecByType div 1000, '.', profAddRecByType mod 1000, ' milliseconds');
3056 writeln('field valparse: ', profFieldValParsing div 1000, '.', profFieldValParsing mod 1000, ' milliseconds');
3057 writeln('fix defaults : ', profFixDefaults div 1000, '.', profFixDefaults mod 1000, ' milliseconds');
3058 writeln('recvalparse : ', profRecValParse div 1000, '.', profRecValParse mod 1000, ' milliseconds');
3060 {$ENDIF}
3064 var
3068 {$IF DEFINED(D2D_DYNREC_PROFILER)}
3070 {$ENDIF}
3073 var
3076 begin
3078 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
3080 begin
3082 begin
3086 begin
3087 //if (fld.mRecRef <> nil) then linkNames(fld.mRecRef);
3088 continue;
3094 begin
3095 //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);
3096 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]);
3098 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
3104 begin
3105 //writeln(' ', fld.mName);
3110 begin
3111 if (mOwner = nil) then raise TDynParseException.CreateFmt(pr, 'can''t parse record ''%s'' value without owner', [mTypeName]);
3115 // not a header?
3117 begin
3118 // id?
3120 end
3121 else
3122 begin
3126 //writeln('parsing record <', mName, '>');
3129 begin
3131 //writeln('<', mName, '.', pr.tokStr, '>');
3133 // records
3135 begin
3136 // add records with this type (if any)
3141 begin
3146 // on error, it will be freed by memowner
3152 continue;
3156 // fields
3158 //writeln('0: <', mName, '.', pr.tokStr, '>');
3160 //writeln('1: <', mName, '.', pr.tokStr, '>');
3163 begin
3164 //writeln('2: <', mName, '.', pr.tokStr, '>');
3165 if fld.defined then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in record ''%s''', [fld.mName, mTypeName]);
3166 if fld.internal then raise TDynParseException.CreateFmt(pr, 'internal field ''%s'' in record ''%s''', [fld.mName, mTypeName]);
3168 //writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType);
3172 continue;
3175 // something is wrong
3176 raise TDynParseException.CreateFmt(pr, 'unknown field ''%s'' in record ''%s''', [pr.tokStr, mTypeName]);
3181 begin
3182 // link fields
3186 //writeln('done parsing record <', mName, '>');
3187 //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', getTimeMicro()-stall);{$ENDIF}
3192 // ////////////////////////////////////////////////////////////////////////// //
3194 begin
3201 begin
3208 begin
3221 begin
3224 begin
3233 begin
3239 var
3241 begin
3248 var
3250 begin
3254 // fields
3257 begin
3261 begin
3265 end
3266 else
3267 begin
3272 // max field
3279 var
3281 begin
3283 // fields
3285 begin
3292 var
3294 begin
3296 begin
3304 var
3310 begin
3318 begin
3320 begin
3321 if (Length(mTip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for enum/bitset ''%s''', [mTypeName]);
3323 continue;
3326 begin
3327 if (Length(mHelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate help definition for enum/bitset ''%s''', [mTypeName]);
3329 continue;
3331 break;
3335 begin
3338 begin
3339 if StrEqu(mIds[f], idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3341 if StrEqu(mMaxName, idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3345 // has value?
3347 begin
3349 begin
3350 if (Length(mMaxName) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3353 end
3354 else
3355 begin
3361 // append it?
3363 begin
3364 // fix maxvalue
3366 begin
3373 // next cv
3375 begin
3384 // add max field
3386 begin
3395 // ////////////////////////////////////////////////////////////////////////// //
3397 begin
3406 var
3409 begin
3410 //!!!FIXME!!! check who owns trigs and recs!
3425 begin
3432 var
3434 begin
3436 begin
3444 var
3446 begin
3448 begin
3456 var
3458 begin
3460 begin
3468 var
3473 // setup header links and type links
3475 var
3477 begin
3480 begin
3485 begin
3487 if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]);
3491 begin
3493 if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]);
3494 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]);
3500 // setup default values
3502 var
3504 begin
3508 begin
3511 begin
3515 begin
3516 // enum or bitset
3518 begin
3521 begin
3527 //writeln(eb.definition); writeln;
3528 continue;
3531 // triggerdata
3533 begin
3536 begin
3538 begin
3545 //writeln(dr.definition); writeln;
3546 continue;
3551 //writeln(dr.definition); writeln;
3552 if (findRecType(rec.typeName) <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
3553 if (hdr <> nil) and StrEqu(rec.typeName, hdr.typeName) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
3556 begin
3557 if (hdr <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate header record ''%s'' (previous is ''%s'')', [rec.typeName, hdr.typeName]); end;
3559 end
3560 else
3561 begin
3566 // put header record to top
3567 if (hdr = nil) then raise TDynParseException.Create(pr, 'header definition not found in mapdef');
3572 // setup header links and type links
3576 // setup default values
3582 // ////////////////////////////////////////////////////////////////////////// //
3584 var
3586 begin
3588 try
3595 finally
3602 var
3604 begin
3606 try
3612 finally
3618 // WARNING! stream must be seekable
3620 var
3623 begin
3629 begin
3631 begin
3634 exit;
3637 end
3638 else
3639 begin
3641 try
3642 try
3647 finally
3654 // returns `true` if the given stream can be a map file
3655 // stream position is 0 on return
3656 // WARNING! stream must be seekable
3658 var
3661 begin
3666 begin
3668 end
3669 else
3670 begin
3681 var
3683 begin
3685 result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
3692 function TDynMapDef.getRecTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < recTypes.count) then result := recTypes[idx] else result := nil; end;
3695 function TDynMapDef.getEBSTypeAt (idx: Integer): TDynEBS; inline; begin if (idx >= 0) and (idx < ebsTypes.count) then result := ebsTypes[idx] else result := nil; end;
3697 function TDynMapDef.getTrigTypeCount (): Integer; inline; begin result := trigTypes.count; end;
3698 function TDynMapDef.getTrigTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < trigTypes.count) then result := trigTypes[idx] else result := nil; end;