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, TColor, 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
95 mAsMonsterId: Boolean; // special hack for triggers: monster record number+1 in binary (so 0 means "none")
96 // default value
103 mEBSType: TObject; // either TDynRecord or TDynEBS; nil means "simple type"; nil for `TTrigData` too
105 // for binary parser
108 // for userdata
112 // for pasgen
115 private
118 procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef`
136 protected
137 // returns `true` for duplicate record id
141 public
142 // get string name for the given type
145 public
151 // clone this field; register all list records in `registerIn`
152 // "registration" is required to manage record lifetime; use header record if in doubt
153 // owner will be set to `newOwner`, if it is not `nil`, or to `owner`
154 // for lists, cloning will clone all list members
157 // compare field values (including trigdata)
158 // WARNING: won't work for lists
161 // parse string value to appropriate type and set new field value
164 // supports `for rec in field do` (for lists)
179 public
180 // text parser and writer
184 // binary parser and writer (DO NOT USE!)
188 public
189 // the following functions are here only for 'mapgen'! DO NOT USE!
190 // build "alias name" for pascal code
193 public
199 property ival: Integer read mIVal; // integer value for int field (for speed), first field (x/w) for `TPoint` and `TSize`
208 property hasDefault: Boolean read mHasDefault; // `true` if this field has default value in mapdef
211 property ebstype: TObject read mEBSType; // reference type (nil, TDynRecord, TDynEBS); WARNING: don't modify type!
213 property recref: TDynRecord read mRecRef write setRecRef; // referenced record (actual one, you can modify it)
214 property recrefIndex: Integer read getRecRefIndex; // index of referenced record in header; -1: not found
215 // for record lists
218 property item[const aname: AnsiString]: TDynRecord read getListItem; default; // alas, FPC 3+ lost property overloading feature
219 // field value as Variant
225 public
226 // userdata (you can use these properties as you want to; they won't be written or read to files)
230 public
231 // the following properties are here only for 'mapgen'! DO NOT USE!
240 // record, either with actual values, or with type definitions
242 private
250 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
252 {$ENDIF}
256 mHeaderRec: TDynRecord; // for "value" records this is header record with data, for "type" records this is header type record
258 // for userdata
264 private
287 protected
290 function addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean; // `true`: duplicate record id
295 public
300 // clone this record; register all list records in `registerIn`
301 // "registration" is required to manage record lifetime; use header record if in doubt
302 // all fields are cloned too
305 // compare records (values of all fields, including trigdata)
306 // WARNING: won't work for records with list fields
309 // find field with `TriggerType` type
312 // number of records of the given instance
315 // only for headers: create new record with the given type
316 // will return cloned record ready for use, or `nil` on unknown type name
317 // `aid` must not be empty, and must be unique
320 // remove record with the given type and id
321 // return `true` if record was successfully found and removed
322 // this will do all necessary recref cleanup too
323 // WARNING: not tested yet
326 //TODO:
327 // [.] API to create triggers
328 // [.] API to properly remove triggers (remove trigdata)
329 // [.] check if `removeTypedRecord()` does the right thing with inline records
330 // [.] for fields: assigning `recref` should remove previously assigned inline record (record without id)
331 // [.] other API i forgot
333 public
334 // text parser
335 // `beginEaten`: `true` if "{" was eaten
338 // text writer
339 // `putHeader`: `true` to write complete header, otherwise only "{...}"
342 // binary parser and writer (DO NOT USE!)
344 procedure writeBinTo (var hasLostData: Boolean; st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
346 public
350 property has[const aname: AnsiString]: Boolean read hasByName; // do we have field with the given name?
352 property field[const aname: AnsiString]: TDynField read getFieldByName; default; // get field by name
355 property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig; // can this "TriggerData" be used for the trigger with the given type?
356 property forTrigCount: Integer read getForTrigCount; // number of trigger type names for "TriggerData"
357 property forTrigAt[idx: Integer]: AnsiString read getForTrigAt; // trigger type name at the given index for "TriggerData"
358 property headerRec: TDynRecord read mHeaderRec; // get header record for this one (header contains all other records, enums, bitsets, etc.)
364 public
365 // user fields; user can add arbitrary custom fields
366 // by default, any user field will be marked as "internal"
367 // note: you can use this to manipulate non-user fields too
370 public
371 // userdata (you can use these properties as you want to; they won't be written or read to files)
377 // bitset/enum definition
379 private
390 private
402 public
406 // find name for the given value
407 // return empty string if not found
410 public
422 // parsed "mapdef.txt"
424 public
429 private
443 // creates new header record
446 // creates new header record
449 public
457 public
458 // parse text or binary map, return new header record
459 // WARNING! stream must be seekable
462 // returns `true` if the given stream can be a map file
463 // stream position is 0 on return
464 // WARNING! stream must be seekable
467 public
468 // the following functions are here only for 'mapgen'! DO NOT USE!
471 public
473 // for record types
477 // for enum/bitset types
481 // for trigtypes
488 {$IF DEFINED(D2D_DYNREC_PROFILER)}
490 {$ENDIF}
493 implementation
495 uses
496 e_log
500 // ////////////////////////////////////////////////////////////////////////// //
504 // ////////////////////////////////////////////////////////////////////////// //
506 begin
511 begin
516 // ////////////////////////////////////////////////////////////////////////// //
518 begin
519 if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
523 constructor TDynParseException.CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
524 begin
525 if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
530 // ////////////////////////////////////////////////////////////////////////// //
532 begin
533 //result := TListEnumerator.Create(mRVal);
534 if (mRVal <> nil) then result := mRVal.GetEnumerator else result := TDynRecList.TEnumerator.Create(nil, 0);
538 // ////////////////////////////////////////////////////////////////////////// //
540 begin
548 begin
556 begin
564 begin
588 else
592 begin
629 begin
636 begin
680 var
682 begin
696 begin
731 var
734 begin
736 begin
737 if firstUp then result := UpCase1251(mAlias[1])+Copy(mAlias, 2, Length(mAlias)-1) else result := mAlias;
738 end
739 else
740 begin
744 begin
754 var
756 begin
758 TEBS.TNone: raise TDynRecException.CreateFmt('cannot set refrec for non-reference field ''%s''', [mName]);
760 begin
762 begin
764 if (trc = nil) then raise TDynRecException.CreateFmt('cannot set refrec for field ''%s'' (type conflict: improperly initialized field)', [mName]);
765 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]);
769 exit;
771 TEBS.TEnum: raise TDynRecException.CreateFmt('cannot set refrec for enum field ''%s''', [mName]);
772 TEBS.TBitSet: raise TDynRecException.CreateFmt('cannot set refrec for bitset field ''%s''', [mName]);
779 begin
796 else result := Unassigned; raise TDynRecException.Create('ketmar forgot to handle some field type');
803 begin
827 else
831 begin
842 varString:
844 begin
846 end
847 else
848 begin
852 varBoolean:
864 else
869 varByte,
870 varWord,
871 varShortInt,
872 varSmallint,
873 varInteger:
875 varInt64:
878 else
880 varLongWord:
881 if (val > LongWord($7FFFFFFF)) then raise TDynRecException.Create('cannot convert longword variant to field value')
891 // won't work for lists
893 begin
910 result := ((mIVal = fld.mIVal) and (mIVal2 = fld.mIVal2) and (mIVal3 = fld.mIVal3) and (mIVal4 = fld.mIVal4));
913 begin
923 var
925 begin
927 try
929 finally
935 function TDynField.getRed (): Integer; inline; begin result := mIVal; if (result < 0) then result := 0 else if (result > 255) then result := 255; end;
936 procedure TDynField.setRed (v: Integer); inline; begin if (v < 0) then v := 0 else if (v > 255) then v := 255; mIVal := v; end;
938 function TDynField.getGreen (): Integer; inline; begin result := mIVal2; if (result < 0) then result := 0 else if (result > 255) then result := 255; end;
939 procedure TDynField.setGreen (v: Integer); inline; begin if (v < 0) then v := 0 else if (v > 255) then v := 255; mIVal2 := v; end;
941 function TDynField.getBlue (): Integer; inline; begin result := mIVal3; if (result < 0) then result := 0 else if (result > 255) then result := 255; end;
942 procedure TDynField.setBlue (v: Integer); inline; begin if (v < 0) then v := 0 else if (v > 255) then v := 255; mIVal3 := v; end;
944 function TDynField.getAlpha (): Integer; inline; begin result := mIVal4; if (result < 0) then result := 0 else if (result > 255) then result := 255; end;
945 procedure TDynField.setAlpha (v: Integer); inline; begin if (v < 0) then v := 0 else if (v > 255) then v := 255; mIVal4 := v; end;
949 var
955 begin
957 begin
964 end
965 else
966 begin
974 try
983 finally
997 // default value should be parsed
999 begin
1002 begin
1004 raise TDynRecException.CreateFmt('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mTypeName]);
1016 // default value should be parsed
1018 begin
1024 TType.TColor: result := (mIVal = mDefIVal2) and (mIVal2 = mDefIVal2) and (mIVal3 = mDefIVal3) and (mIVal4 = mDefIVal4);
1032 begin
1038 begin
1039 if (mRVal <> nil) and (idx >= 0) and (idx < mRVal.count) then result := mRVal[idx] else result := nil;
1044 var
1046 begin
1052 begin
1055 begin
1063 var
1065 begin
1068 begin
1071 // fix hash and list
1073 begin
1083 begin
1105 begin
1115 TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
1120 begin
1121 if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
1122 else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
1130 var
1150 begin
1180 begin
1182 begin
1183 if (Length(fldtype) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate type definition for field ''%s''', [fldname]);
1188 begin
1190 // arbitrary limits
1191 if (lmaxdim < 1) or (lmaxdim > 32768) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' array size', [fldname]);
1193 end;
1194 continue;
1198 begin
1199 if (Length(xalias) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate alias definition for field ''%s''', [fldname]);
1201 continue;
1205 begin
1206 if (Length(atip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for field ''%s''', [fldname]);
1208 continue;
1212 begin
1213 if (Length(ahelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for field ''%s''', [fldname]);
1215 continue;
1219 begin
1220 if (fldofs >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' offset', [fldname]);
1222 if (fldofs < 0) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' offset', [fldname]);
1223 continue;
1227 begin
1234 continue;
1235 end;
1238 begin
1240 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1242 continue;
1246 begin
1248 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1251 continue;
1255 begin
1256 if hasdefStr or hasdefInt or hasdefId then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has duplicate default', [fldname]);
1259 begin
1264 begin
1269 begin
1274 begin
1280 begin
1286 else
1289 continue;
1293 begin
1295 continue;
1299 begin
1301 continue;
1304 // record type, no special modifiers
1305 if (pr.tokType <> pr.TTId) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has something unexpected in definition', [fldname]);
1307 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1314 // create field
1330 else
1331 begin
1332 // record types defaults to int
1334 begin
1336 end
1337 else
1338 begin
1339 if (Length(fldtype) = 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has no type', [fldname])
1340 else raise TDynParseException.CreateFmt(pr, 'field ''%s'' has invalid type ''%s''', [fldname, fldtype]);
1344 // check for valid arrays
1345 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]);
1347 // check for valid trigdata or record type
1349 begin
1350 // trigdata
1351 if (lmaxdim < 1) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot be non-array', [fldname, 'trigdata']);
1352 if (Length(fldrecname) > 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot have another type', [fldname, 'trigdata']);
1354 end
1356 begin
1357 // record
1358 if not (mType in [TType.TByte, TType.TUByte, TType.TShort, TType.TUShort, TType.TInt, TType.TUInt]) then
1359 begin
1360 raise TDynParseException.CreateFmt(pr, 'field ''%s'' of record type ''%s'' cannot have type ''%s''', [fldname, fldrecname, fldtype]);
1364 // setup default value
1368 begin
1371 else if (mType = TType.TColor) then self.mDefUnparsed := Format('(%d %d %d %d)', [defint, defint2, defint3, defint4])
1389 end;
1393 begin
1400 var
1406 begin
1410 begin
1412 begin
1413 // this must be triggerdata
1415 begin
1416 raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1418 // write triggerdata
1420 if (buf = nil) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1421 try
1424 begin
1429 finally
1433 exit;
1435 // record reference
1443 else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1445 // find record number
1447 begin
1449 if (f < 0) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]);
1451 if (f > maxv) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]);
1452 end
1453 else
1454 begin
1461 else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1463 exit;
1472 begin
1474 begin
1476 end
1477 else
1478 begin
1481 exit;
1484 begin
1485 if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1487 begin
1488 if (Length(mSVal) <> 1) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1490 end
1491 else
1492 begin
1493 if (Length(mSVal) > mMaxDim) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1498 exit;
1502 begin
1503 // triggerdata array was processed earlier
1504 if (mMaxDim >= 0) then TDynRecException.CreateFmt('byte array in field ''%s'' cannot be written', [mName]);
1506 exit;
1510 begin
1511 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('short array in field ''%s'' cannot be written', [mName]);
1513 exit;
1517 begin
1518 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('int array in field ''%s'' cannot be written', [mName]);
1520 exit;
1523 begin
1527 begin
1528 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
1531 exit;
1534 begin
1535 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
1538 exit;
1541 begin
1542 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('color array in field ''%s'' cannot be written', [mName]);
1546 //writeInt(st, Byte(mIVal4)); // the only place we have RGB in binary map is effect trigger, and it has no alpha
1548 exit;
1560 var
1564 begin
1570 begin
1572 begin
1574 end
1576 begin
1578 end
1579 else
1580 begin
1584 exit;
1587 begin
1588 //def := mOwner.mOwner;
1589 //es := def.ebsType[mEBSTypeName];
1592 if (es = nil) or (not es.mIsEnum) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1594 begin
1596 begin
1599 exit;
1602 raise TDynRecException.CreateFmt('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]);
1605 begin
1606 //def := mOwner.mOwner;
1607 //es := def.ebsType[mEBSTypeName];
1610 if (es = nil) or es.mIsEnum then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1611 // none?
1613 begin
1615 begin
1617 begin
1620 exit;
1623 raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]);
1625 // not none
1629 begin
1631 begin
1634 begin
1636 begin
1640 break;
1643 if not found then raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]);
1648 exit;
1655 begin
1657 exit;
1660 begin
1661 if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1664 exit;
1672 begin
1674 exit;
1677 begin
1680 exit;
1684 begin
1686 exit;
1689 begin
1692 exit;
1695 begin
1697 exit;
1700 begin
1702 exit;
1711 var
1718 begin
1722 begin
1723 // this must be triggerdata
1725 begin
1728 // find trigger definition
1730 if (tfld = nil) then raise TDynRecException.CreateFmt('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mTypeName]);
1732 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]);
1735 // on error, it will be freed by memowner
1739 exit;
1740 end
1741 else
1742 begin
1743 // not a trigger data
1751 else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
1757 exit;
1761 begin
1770 else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
1774 if (es = nil) or (es.mIsEnum <> (mEBS = TEBS.TEnum)) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1776 // build enum/bitfield values
1778 begin
1780 if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
1781 end
1782 else
1783 begin
1784 // special for 'none'
1786 begin
1788 if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
1789 end
1790 else
1791 begin
1795 begin
1797 begin
1799 if (Length(s) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]);
1807 //writeln('ebs <', es.mName, '>: ', mSVal);
1809 exit;
1816 begin
1822 exit;
1825 begin
1827 begin
1829 end
1830 else
1831 begin
1834 try
1839 begin
1844 finally
1849 exit;
1858 begin
1860 exit;
1863 begin
1867 exit;
1870 begin
1874 exit;
1877 begin
1881 //mIVal4 := readByte(st); // the only place we have RGB in binary map is effect trigger, and it has no alpha
1884 exit;
1887 begin
1889 exit;
1892 begin
1894 exit;
1905 begin
1907 if (mIVal < min) or (mIVal > max) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
1911 var
1917 begin
1920 // if this field should contain struct, convert type and parse struct
1924 begin
1925 // ugly hack. sorry.
1927 begin
1930 begin
1931 // '{}'
1934 end
1935 else
1936 begin
1938 // find trigger definition
1940 if (tfld = nil) then raise TDynParseException.CreateFmt(pr, 'triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mTypeName]);
1942 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]);
1945 //writeln(rc.definition);
1946 // on error, it will be freed by memowner
1952 exit;
1954 // other record types
1956 begin
1958 begin
1960 end
1961 else
1962 begin
1965 begin
1967 end
1968 else
1969 begin
1977 exit;
1978 end
1980 begin
1981 //rec := mOwner.mOwner.recType[mEBSTypeName]; // find in mapdef
1984 if (rec = nil) then raise TDynParseException.CreateFmt(pr, 'record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1991 begin
1992 raise TDynParseException.CreateFmt(pr, 'duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mTypeName]);
1995 exit;
2000 begin
2001 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
2004 if (es = nil) or (not es.mIsEnum) then raise TDynParseException.CreateFmt(pr, 'record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
2006 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]);
2009 //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
2012 exit;
2015 begin
2016 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
2019 if (es = nil) or es.mIsEnum then raise TDynParseException.CreateFmt(pr, 'record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
2022 begin
2024 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]);
2028 if mBitSetUnique then raise TDynParseException.CreateFmt(pr, 'record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]);
2033 exit;
2040 begin
2046 exit;
2049 begin
2050 if (mMaxDim = 0) then raise TDynParseException.CreateFmt(pr, 'invalid string size definition for field ''%s''', [mName]);
2053 begin
2054 // single char
2055 if (Length(mSVal) <> 1) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
2058 end
2059 else
2060 begin
2061 // string
2062 if (Length(mSVal) > mMaxDim) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
2066 exit;
2069 begin
2072 exit;
2075 begin
2078 exit;
2081 begin
2084 exit;
2087 begin
2090 exit;
2093 begin
2096 exit;
2099 begin
2102 exit;
2105 begin
2109 exit;
2113 begin
2117 begin
2118 if (mIVal < 0) or (mIVal > 65535) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2122 begin
2123 if (mIVal2 < 0) or (mIVal2 > 65535) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2128 exit;
2131 begin
2134 if (mIVal < 0) or (mIVal > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2136 if (mIVal2 < 0) or (mIVal2 > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2138 if (mIVal3 < 0) or (mIVal3 > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2140 begin
2142 if (mIVal4 < 0) or (mIVal4 > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2143 end
2144 else
2145 begin
2151 exit;
2154 begin
2156 exit;
2159 begin
2161 exit;
2169 // ////////////////////////////////////////////////////////////////////////// //
2171 begin
2172 if (pr = nil) then raise TDynParseException.Create(pr, 'cannot create record type without type definition');
2177 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2179 {$ENDIF}
2191 begin
2195 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2197 {$ENDIF}
2208 var
2211 begin
2213 begin
2215 begin
2217 begin
2218 //writeln(formatstrf('freeing: 0x%08x; name=%s; id=%s', [Pointer(rec), rec.mName, rec.mId]));
2229 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2232 {$ENDIF}
2242 begin
2244 begin
2252 begin
2255 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2257 {$ENDIF}
2261 function TDynRecord.addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
2262 begin
2265 {$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
2267 {$ENDIF}
2269 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2271 {$ENDIF}
2276 begin
2277 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2279 {$ELSE}
2282 begin
2287 {$ENDIF}
2292 begin
2298 var
2300 begin
2307 begin
2313 begin
2319 begin
2325 var
2327 begin
2335 begin
2341 begin
2347 var
2350 begin
2364 begin
2375 var
2378 begin
2381 // find record data
2384 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2385 // find by id
2387 begin
2390 // alas
2394 function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
2395 var
2398 begin
2400 // find record data
2403 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2404 // find by ref
2406 begin
2408 begin
2412 // alas
2417 var
2419 begin
2420 // find record data
2423 begin
2424 // first record
2429 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2430 // append
2432 begin
2441 var
2443 begin
2449 begin
2457 var
2460 begin
2462 begin
2473 // number of records of the given instance
2475 var
2477 begin
2485 var
2488 begin
2489 if not mHeader then raise TDynRecException.Create('cannot create new records with non-header');
2490 if (Length(aid) = 0) then raise TDynRecException.CreateFmt('cannot create new record of type ''%s'' without id', [atypename]);
2493 // check if aid is unique
2495 if (fld <> nil) and (fld.getListItem(aid) <> nil) then raise TDynRecException.CreateFmt('cannot create record of type ''%s'' with duplicate id ''%s''', [atypename, aid]);
2504 var
2506 begin
2511 var
2513 begin
2519 // remove record with the given type and id
2520 // return `true` if record was successfully found and removed
2521 // this will do all necessary recref cleanup too
2523 var
2528 begin
2540 begin
2542 begin
2552 var
2554 begin
2561 var
2563 begin
2566 begin
2567 if (Length(aname) = 0) then raise TDynRecException.Create('cannot create nameless user field');
2572 end
2573 else
2574 begin
2581 var
2584 begin
2586 begin
2589 begin
2591 begin
2595 if isForTrig[tdn] then raise TDynParseException.CreateFmt(pr, 'duplicate trigdata ''%s'' trigtype ''%s''', [mTypeName, tdn]);
2599 end
2600 else
2601 begin
2607 end
2608 else
2609 begin
2612 begin
2615 begin
2616 if (mSize > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `size` in record ''%s''', [mTypeName]);
2618 if (mSize < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' size: %d', [mTypeName, mSize]);
2620 continue;
2623 begin
2624 if (mBinBlock >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `binblock` in record ''%s''', [mTypeName]);
2626 if (mBinBlock < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' binblock: %d', [mTypeName, mBinBlock]);
2627 continue;
2630 begin
2631 if (Length(mTip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for record ''%s''', [mTypeName]);
2633 continue;
2636 begin
2637 if (Length(mHelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate help definition for record ''%s''', [mTypeName]);
2639 continue;
2645 // load fields
2647 begin
2649 // append
2652 begin
2656 // done with field
2663 var
2665 begin
2667 begin
2668 // trigger data
2671 begin
2674 begin
2679 end
2680 else
2681 begin
2684 end
2685 else
2686 begin
2687 // record
2694 begin
2704 var
2716 var
2719 begin
2720 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2722 begin
2724 begin
2726 continue;
2732 begin
2733 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);
2734 //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]);
2736 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2742 begin
2743 //writeln(' ', fld.mName);
2748 begin
2751 try
2753 begin
2754 // parse map file as sequence of blocks
2758 // parse blocks
2760 begin
2766 if (bsize < 0) or (bsize > $1fffffff) then raise TDynRecException.CreateFmt('block of type %d has invalid size %d', [btype, bsize]);
2767 if loaded[btype] then raise TDynRecException.CreateFmt('block of type %d already loaded', [btype]);
2769 // find record type for this block
2772 if (rect = nil) then raise TDynRecException.CreateFmt('block of type %d has no corresponding record', [btype]);
2773 //writeln('found type ''', rec.mName, ''' for block type ', btype);
2774 if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise TDynRecException.CreateFmt('block of type %d has invalid number of records', [btype]);
2775 // header?
2777 begin
2778 if (bsize <> mSize) then raise TDynRecException.CreateFmt('header block of type %d has invalid number of records', [btype]);
2783 end
2784 else
2785 begin
2786 // create list for this type
2791 begin
2795 begin
2802 //writeln('parsed ''', rec.mId, '''...');
2808 //st.position := st.position+bsize;
2810 // link fields
2812 begin
2816 exit;
2819 // read fields
2821 if (mSize < 1) then raise TDynRecException.CreateFmt('cannot read record of type ''%s'' with unknown size', [mTypeName]);
2825 begin
2828 if (fld.mBinOfs >= st.size) then raise TDynRecException.CreateFmt('record of type ''%s'' has invalid field ''%s''', [fld.mName]);
2830 //writeln('parsing ''', mName, '.', fld.mName, '''...');
2833 finally
2840 procedure TDynRecord.writeBinTo (var hasLostData: Boolean; st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
2841 var
2849 begin
2851 begin
2852 if (mBinBlock < 1) then raise TDynRecException.Create('cannot write binary record without block number');
2855 end
2856 else
2857 begin
2860 try
2865 // write normal fields
2867 begin
2868 // record list?
2872 begin
2874 continue;
2876 if (fld.mBinOfs >= bufsz) then raise TDynRecException.Create('binary value offset is outside of the buffer');
2878 //writeln('writing field <', fld.mName, '>');
2882 // write block with normal fields
2884 begin
2885 //writeln('writing header...');
2886 // signature and version
2897 // write other blocks, if any
2899 begin
2900 // calculate blkmax
2903 begin
2904 // record list?
2906 begin
2914 // write blocks
2916 begin
2920 begin
2921 // record list?
2923 begin
2932 // flush block
2934 begin
2945 // write end marker
2950 finally
2958 var
2963 begin
2965 begin
2972 try
2974 begin
2975 // record list?
2977 begin
2980 begin
2983 begin
2986 begin
2989 begin
2999 end
3000 else
3001 begin
3008 continue;
3015 finally
3023 {$IF DEFINED(D2D_DYNREC_PROFILER)}
3024 var
3035 begin
3037 writeln('record cloning: ', profCloneRec div 1000, '.', profCloneRec mod 1000, ' milliseconds');
3038 writeln('findRecType : ', profFindRecType div 1000, '.', profFindRecType mod 1000, ' milliseconds');
3039 writeln('field[] : ', profFieldSearching div 1000, '.', profFieldSearching mod 1000, ' milliseconds');
3040 writeln('list dup check: ', profListDupChecking div 1000, '.', profListDupChecking mod 1000, ' milliseconds');
3041 writeln('addRecByType : ', profAddRecByType div 1000, '.', profAddRecByType mod 1000, ' milliseconds');
3042 writeln('field valparse: ', profFieldValParsing div 1000, '.', profFieldValParsing mod 1000, ' milliseconds');
3043 writeln('fix defaults : ', profFixDefaults div 1000, '.', profFixDefaults mod 1000, ' milliseconds');
3044 writeln('recvalparse : ', profRecValParse div 1000, '.', profRecValParse mod 1000, ' milliseconds');
3046 {$ENDIF}
3050 var
3054 {$IF DEFINED(D2D_DYNREC_PROFILER)}
3056 {$ENDIF}
3059 var
3062 begin
3063 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
3065 begin
3067 begin
3069 continue;
3075 begin
3076 //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);
3077 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]);
3079 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
3085 begin
3086 //writeln(' ', fld.mName);
3091 begin
3092 if (mOwner = nil) then raise TDynParseException.CreateFmt(pr, 'can''t parse record ''%s'' value without owner', [mTypeName]);
3096 // not a header?
3098 begin
3099 // id?
3101 end
3102 else
3103 begin
3107 //writeln('parsing record <', mName, '>');
3110 begin
3112 //writeln('<', mName, '.', pr.tokStr, '>');
3114 // records
3116 begin
3117 // add records with this type (if any)
3122 begin
3127 // on error, it will be freed by memowner
3133 continue;
3137 // fields
3139 //writeln('0: <', mName, '.', pr.tokStr, '>');
3141 //writeln('1: <', mName, '.', pr.tokStr, '>');
3144 begin
3145 //writeln('2: <', mName, '.', pr.tokStr, '>');
3146 if fld.defined then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in record ''%s''', [fld.mName, mTypeName]);
3147 if fld.internal then raise TDynParseException.CreateFmt(pr, 'internal field ''%s'' in record ''%s''', [fld.mName, mTypeName]);
3149 //writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType);
3153 continue;
3156 // something is wrong
3157 raise TDynParseException.CreateFmt(pr, 'unknown field ''%s'' in record ''%s''', [pr.tokStr, mTypeName]);
3162 begin
3163 // link fields
3165 begin
3171 // fix field defaults
3175 //writeln('done parsing record <', mName, '>');
3176 //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', curTimeMicro()-stall);{$ENDIF}
3181 // ////////////////////////////////////////////////////////////////////////// //
3183 begin
3190 begin
3197 begin
3210 begin
3213 begin
3222 begin
3228 var
3230 begin
3237 var
3239 begin
3243 // fields
3246 begin
3250 begin
3254 end
3255 else
3256 begin
3261 // max field
3268 var
3270 begin
3272 // fields
3274 begin
3281 var
3283 begin
3285 begin
3293 var
3299 begin
3307 begin
3309 begin
3310 if (Length(mTip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for enum/bitset ''%s''', [mTypeName]);
3312 continue;
3315 begin
3316 if (Length(mHelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate help definition for enum/bitset ''%s''', [mTypeName]);
3318 continue;
3320 break;
3324 begin
3327 begin
3328 if StrEqu(mIds[f], idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3330 if StrEqu(mMaxName, idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3334 // has value?
3336 begin
3338 begin
3339 if (Length(mMaxName) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3342 end
3343 else
3344 begin
3350 // append it?
3352 begin
3353 // fix maxvalue
3355 begin
3362 // next cv
3364 begin
3373 // add max field
3375 begin
3384 // ////////////////////////////////////////////////////////////////////////// //
3386 begin
3395 var
3398 begin
3399 //!!!FIXME!!! check who owns trigs and recs!
3414 begin
3421 var
3423 begin
3425 begin
3433 var
3435 begin
3437 begin
3445 var
3447 begin
3449 begin
3457 var
3462 // setup header links and type links
3464 var
3466 begin
3469 begin
3474 begin
3476 if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]);
3480 begin
3482 if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]);
3483 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]);
3489 // setup default values
3491 var
3493 begin
3497 begin
3500 begin
3504 begin
3505 // enum or bitset
3507 begin
3510 begin
3516 //writeln(eb.definition); writeln;
3517 continue;
3520 // triggerdata
3522 begin
3525 begin
3527 begin
3534 //writeln(dr.definition); writeln;
3535 continue;
3540 //writeln(dr.definition); writeln;
3541 if (findRecType(rec.typeName) <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
3542 if (hdr <> nil) and StrEqu(rec.typeName, hdr.typeName) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
3545 begin
3546 if (hdr <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate header record ''%s'' (previous is ''%s'')', [rec.typeName, hdr.typeName]); end;
3548 end
3549 else
3550 begin
3555 // put header record to top
3556 if (hdr = nil) then raise TDynParseException.Create(pr, 'header definition not found in mapdef');
3561 // setup header links and type links
3565 // setup default values
3571 // ////////////////////////////////////////////////////////////////////////// //
3573 var
3575 begin
3577 try
3584 finally
3591 var
3593 begin
3595 try
3601 finally
3607 // WARNING! stream must be seekable
3609 var
3612 begin
3618 begin
3620 begin
3623 exit;
3626 end
3627 else
3628 begin
3630 try
3631 try
3636 finally
3643 // returns `true` if the given stream can be a map file
3644 // stream position is 0 on return
3645 // WARNING! stream must be seekable
3647 var
3650 begin
3655 begin
3657 end
3658 else
3659 begin
3670 var
3672 begin
3674 result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
3681 function TDynMapDef.getRecTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < recTypes.count) then result := recTypes[idx] else result := nil; end;
3684 function TDynMapDef.getEBSTypeAt (idx: Integer): TDynEBS; inline; begin if (idx >= 0) and (idx < ebsTypes.count) then result := ebsTypes[idx] else result := nil; end;
3686 function TDynMapDef.getTrigTypeCount (): Integer; inline; begin result := trigTypes.count; end;
3687 function TDynMapDef.getTrigTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < trigTypes.count) then result := trigTypes[idx] else result := nil; end;