4afab5f2a2f5b31812bc36b9fbaaf5a53590bbc6
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
977 //if (mType = TType.TColor) then writeln('4=[', mIVal4, ']');
984 finally
998 // default value should be parsed
1000 begin
1003 begin
1005 raise TDynRecException.CreateFmt('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mTypeName]);
1013 //if (mType = TType.TColor) then writeln('4=[', mDefIVal4, ']');
1018 // default value should be parsed
1020 begin
1026 TType.TColor: result := (mIVal = mDefIVal2) and (mIVal2 = mDefIVal2) and (mIVal3 = mDefIVal3) and (mIVal4 = mDefIVal4);
1034 begin
1040 begin
1041 if (mRVal <> nil) and (idx >= 0) and (idx < mRVal.count) then result := mRVal[idx] else result := nil;
1046 var
1048 begin
1054 begin
1057 begin
1065 var
1067 begin
1070 begin
1073 // fix hash and list
1075 begin
1085 begin
1107 begin
1117 TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
1122 begin
1123 if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
1124 else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
1132 var
1152 begin
1182 begin
1184 begin
1185 if (Length(fldtype) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate type definition for field ''%s''', [fldname]);
1190 begin
1192 // arbitrary limits
1193 if (lmaxdim < 1) or (lmaxdim > 32768) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' array size', [fldname]);
1195 end;
1196 continue;
1200 begin
1201 if (Length(xalias) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate alias definition for field ''%s''', [fldname]);
1203 continue;
1207 begin
1208 if (Length(atip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for field ''%s''', [fldname]);
1210 continue;
1214 begin
1215 if (Length(ahelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for field ''%s''', [fldname]);
1217 continue;
1221 begin
1222 if (fldofs >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' offset', [fldname]);
1224 if (fldofs < 0) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' offset', [fldname]);
1225 continue;
1229 begin
1236 continue;
1237 end;
1240 begin
1242 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1244 continue;
1248 begin
1250 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1253 continue;
1257 begin
1258 if hasdefStr or hasdefInt or hasdefId then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has duplicate default', [fldname]);
1261 begin
1266 begin
1271 begin
1276 begin
1282 begin
1288 else
1291 continue;
1295 begin
1297 continue;
1301 begin
1303 continue;
1306 // record type, no special modifiers
1307 if (pr.tokType <> pr.TTId) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has something unexpected in definition', [fldname]);
1309 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1316 // create field
1332 else
1333 begin
1334 // record types defaults to int
1336 begin
1338 end
1339 else
1340 begin
1341 if (Length(fldtype) = 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has no type', [fldname])
1342 else raise TDynParseException.CreateFmt(pr, 'field ''%s'' has invalid type ''%s''', [fldname, fldtype]);
1346 // check for valid arrays
1347 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]);
1349 // check for valid trigdata or record type
1351 begin
1352 // trigdata
1353 if (lmaxdim < 1) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot be non-array', [fldname, 'trigdata']);
1354 if (Length(fldrecname) > 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot have another type', [fldname, 'trigdata']);
1356 end
1358 begin
1359 // record
1360 if not (mType in [TType.TByte, TType.TUByte, TType.TShort, TType.TUShort, TType.TInt, TType.TUInt]) then
1361 begin
1362 raise TDynParseException.CreateFmt(pr, 'field ''%s'' of record type ''%s'' cannot have type ''%s''', [fldname, fldrecname, fldtype]);
1366 // setup default value
1370 begin
1373 else if (mType = TType.TColor) then self.mDefUnparsed := Format('(%d %d %d %d)', [defint, defint2, defint3, defint4])
1391 end;
1395 begin
1402 var
1408 begin
1412 begin
1414 begin
1415 // this must be triggerdata
1417 begin
1418 raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1420 // write triggerdata
1422 if (buf = nil) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1423 try
1426 begin
1431 finally
1435 exit;
1437 // record reference
1445 else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1447 // find record number
1449 begin
1451 if (f < 0) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]);
1453 if (f > maxv) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]);
1454 end
1455 else
1456 begin
1463 else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1465 exit;
1474 begin
1476 begin
1478 end
1479 else
1480 begin
1483 exit;
1486 begin
1487 if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1489 begin
1490 if (Length(mSVal) <> 1) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1492 end
1493 else
1494 begin
1495 if (Length(mSVal) > mMaxDim) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1500 exit;
1504 begin
1505 // triggerdata array was processed earlier
1506 if (mMaxDim >= 0) then TDynRecException.CreateFmt('byte array in field ''%s'' cannot be written', [mName]);
1508 exit;
1512 begin
1513 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('short array in field ''%s'' cannot be written', [mName]);
1515 exit;
1519 begin
1520 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('int array in field ''%s'' cannot be written', [mName]);
1522 exit;
1525 begin
1529 begin
1530 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
1533 exit;
1536 begin
1537 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
1540 exit;
1543 begin
1544 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('color array in field ''%s'' cannot be written', [mName]);
1548 //writeInt(st, Byte(mIVal4)); // the only place we have RGB in binary map is effect trigger, and it has no alpha
1550 exit;
1562 var
1566 begin
1572 begin
1574 begin
1576 end
1578 begin
1580 end
1581 else
1582 begin
1586 exit;
1589 begin
1590 //def := mOwner.mOwner;
1591 //es := def.ebsType[mEBSTypeName];
1594 if (es = nil) or (not es.mIsEnum) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1596 begin
1598 begin
1601 exit;
1604 raise TDynRecException.CreateFmt('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]);
1607 begin
1608 //def := mOwner.mOwner;
1609 //es := def.ebsType[mEBSTypeName];
1612 if (es = nil) or es.mIsEnum then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1613 // none?
1615 begin
1617 begin
1619 begin
1622 exit;
1625 raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]);
1627 // not none
1631 begin
1633 begin
1636 begin
1638 begin
1642 break;
1645 if not found then raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]);
1650 exit;
1657 begin
1659 exit;
1662 begin
1663 if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1666 exit;
1674 begin
1676 exit;
1679 begin
1682 exit;
1686 begin
1688 exit;
1691 begin
1694 exit;
1697 begin
1699 exit;
1702 begin
1704 exit;
1713 var
1720 begin
1724 begin
1725 // this must be triggerdata
1727 begin
1730 // find trigger definition
1732 if (tfld = nil) then raise TDynRecException.CreateFmt('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mTypeName]);
1734 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]);
1737 // on error, it will be freed by memowner
1741 exit;
1742 end
1743 else
1744 begin
1745 // not a trigger data
1753 else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
1759 exit;
1763 begin
1772 else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
1776 if (es = nil) or (es.mIsEnum <> (mEBS = TEBS.TEnum)) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1778 // build enum/bitfield values
1780 begin
1782 if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
1783 end
1784 else
1785 begin
1786 // special for 'none'
1788 begin
1790 if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
1791 end
1792 else
1793 begin
1797 begin
1799 begin
1801 if (Length(s) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]);
1809 //writeln('ebs <', es.mName, '>: ', mSVal);
1811 exit;
1818 begin
1824 exit;
1827 begin
1829 begin
1831 end
1832 else
1833 begin
1836 try
1841 begin
1846 finally
1851 exit;
1860 begin
1862 exit;
1865 begin
1869 exit;
1872 begin
1876 exit;
1879 begin
1883 //mIVal4 := readByte(st); // the only place we have RGB in binary map is effect trigger, and it has no alpha
1886 exit;
1889 begin
1891 exit;
1894 begin
1896 exit;
1907 begin
1909 if (mIVal < min) or (mIVal > max) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
1913 var
1919 begin
1922 // if this field should contain struct, convert type and parse struct
1926 begin
1927 // ugly hack. sorry.
1929 begin
1932 begin
1933 // '{}'
1936 end
1937 else
1938 begin
1940 // find trigger definition
1942 if (tfld = nil) then raise TDynParseException.CreateFmt(pr, 'triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mTypeName]);
1944 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]);
1947 //writeln(rc.definition);
1948 // on error, it will be freed by memowner
1954 exit;
1956 // other record types
1958 begin
1960 begin
1962 end
1963 else
1964 begin
1967 begin
1969 end
1970 else
1971 begin
1979 exit;
1980 end
1982 begin
1983 //rec := mOwner.mOwner.recType[mEBSTypeName]; // find in mapdef
1986 if (rec = nil) then raise TDynParseException.CreateFmt(pr, 'record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1993 begin
1994 raise TDynParseException.CreateFmt(pr, 'duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mTypeName]);
1997 exit;
2002 begin
2003 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
2006 if (es = nil) or (not es.mIsEnum) then raise TDynParseException.CreateFmt(pr, 'record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
2008 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]);
2011 //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
2014 exit;
2017 begin
2018 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
2021 if (es = nil) or es.mIsEnum then raise TDynParseException.CreateFmt(pr, 'record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
2024 begin
2026 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]);
2030 if mBitSetUnique then raise TDynParseException.CreateFmt(pr, 'record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]);
2035 exit;
2042 begin
2048 exit;
2051 begin
2052 if (mMaxDim = 0) then raise TDynParseException.CreateFmt(pr, 'invalid string size definition for field ''%s''', [mName]);
2055 begin
2056 // single char
2057 if (Length(mSVal) <> 1) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
2060 end
2061 else
2062 begin
2063 // string
2064 if (Length(mSVal) > mMaxDim) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
2068 exit;
2071 begin
2074 exit;
2077 begin
2080 exit;
2083 begin
2086 exit;
2089 begin
2092 exit;
2095 begin
2098 exit;
2101 begin
2104 exit;
2107 begin
2111 exit;
2115 begin
2119 begin
2120 if (mIVal < 0) or (mIVal > 65535) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2124 begin
2125 if (mIVal2 < 0) or (mIVal2 > 65535) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2130 exit;
2133 begin
2136 if (mIVal < 0) or (mIVal > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2138 if (mIVal2 < 0) or (mIVal2 > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2140 if (mIVal3 < 0) or (mIVal3 > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2142 begin
2144 if (mIVal4 < 0) or (mIVal4 > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2145 end
2146 else
2147 begin
2153 exit;
2156 begin
2158 exit;
2161 begin
2163 exit;
2171 // ////////////////////////////////////////////////////////////////////////// //
2173 begin
2174 if (pr = nil) then raise TDynParseException.Create(pr, 'cannot create record type without type definition');
2179 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2181 {$ENDIF}
2193 begin
2197 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2199 {$ENDIF}
2210 var
2213 begin
2215 begin
2217 begin
2219 begin
2220 //writeln(formatstrf('freeing: 0x%08x; name=%s; id=%s', [Pointer(rec), rec.mName, rec.mId]));
2231 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2234 {$ENDIF}
2244 begin
2246 begin
2254 begin
2257 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2259 {$ENDIF}
2263 function TDynRecord.addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
2264 begin
2267 {$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
2269 {$ENDIF}
2271 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2273 {$ENDIF}
2278 begin
2279 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2281 {$ELSE}
2284 begin
2289 {$ENDIF}
2294 begin
2300 var
2302 begin
2309 begin
2315 begin
2321 begin
2327 var
2329 begin
2337 begin
2343 begin
2349 var
2352 begin
2366 begin
2377 var
2380 begin
2383 // find record data
2386 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2387 // find by id
2389 begin
2392 // alas
2396 function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
2397 var
2400 begin
2402 // find record data
2405 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2406 // find by ref
2408 begin
2410 begin
2414 // alas
2419 var
2421 begin
2422 // find record data
2425 begin
2426 // first record
2431 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2432 // append
2434 begin
2443 var
2445 begin
2451 begin
2459 var
2462 begin
2464 begin
2475 // number of records of the given instance
2477 var
2479 begin
2487 var
2490 begin
2491 if not mHeader then raise TDynRecException.Create('cannot create new records with non-header');
2492 if (Length(aid) = 0) then raise TDynRecException.CreateFmt('cannot create new record of type ''%s'' without id', [atypename]);
2495 // check if aid is unique
2497 if (fld <> nil) and (fld.getListItem(aid) <> nil) then raise TDynRecException.CreateFmt('cannot create record of type ''%s'' with duplicate id ''%s''', [atypename, aid]);
2506 var
2508 begin
2513 var
2515 begin
2521 // remove record with the given type and id
2522 // return `true` if record was successfully found and removed
2523 // this will do all necessary recref cleanup too
2525 var
2530 begin
2542 begin
2544 begin
2554 var
2556 begin
2563 var
2565 begin
2568 begin
2569 if (Length(aname) = 0) then raise TDynRecException.Create('cannot create nameless user field');
2574 end
2575 else
2576 begin
2583 var
2586 begin
2588 begin
2591 begin
2593 begin
2597 if isForTrig[tdn] then raise TDynParseException.CreateFmt(pr, 'duplicate trigdata ''%s'' trigtype ''%s''', [mTypeName, tdn]);
2601 end
2602 else
2603 begin
2609 end
2610 else
2611 begin
2614 begin
2617 begin
2618 if (mSize > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `size` in record ''%s''', [mTypeName]);
2620 if (mSize < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' size: %d', [mTypeName, mSize]);
2622 continue;
2625 begin
2626 if (mBinBlock >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `binblock` in record ''%s''', [mTypeName]);
2628 if (mBinBlock < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' binblock: %d', [mTypeName, mBinBlock]);
2629 continue;
2632 begin
2633 if (Length(mTip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for record ''%s''', [mTypeName]);
2635 continue;
2638 begin
2639 if (Length(mHelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate help definition for record ''%s''', [mTypeName]);
2641 continue;
2647 // load fields
2649 begin
2651 // append
2654 begin
2658 // done with field
2665 var
2667 begin
2669 begin
2670 // trigger data
2673 begin
2676 begin
2681 end
2682 else
2683 begin
2686 end
2687 else
2688 begin
2689 // record
2696 begin
2706 var
2718 var
2721 begin
2722 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2724 begin
2726 begin
2728 continue;
2734 begin
2735 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);
2736 //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]);
2738 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2744 begin
2745 //if (fld.mName = 'ambient_color') then writeln('****', fld.mName);
2750 begin
2753 try
2755 begin
2756 // parse map file as sequence of blocks
2760 // parse blocks
2762 begin
2768 if (bsize < 0) or (bsize > $1fffffff) then raise TDynRecException.CreateFmt('block of type %d has invalid size %d', [btype, bsize]);
2769 if loaded[btype] then raise TDynRecException.CreateFmt('block of type %d already loaded', [btype]);
2771 // find record type for this block
2774 if (rect = nil) then raise TDynRecException.CreateFmt('block of type %d has no corresponding record', [btype]);
2775 //writeln('found type ''', rec.mName, ''' for block type ', btype);
2776 if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise TDynRecException.CreateFmt('block of type %d has invalid number of records', [btype]);
2777 // header?
2779 begin
2780 if (bsize <> mSize) then raise TDynRecException.CreateFmt('header block of type %d has invalid number of records', [btype]);
2785 end
2786 else
2787 begin
2788 // create list for this type
2793 begin
2797 begin
2804 //writeln('parsed ''', rec.mId, '''...');
2810 //st.position := st.position+bsize;
2812 // link fields
2814 begin
2818 exit;
2821 // read fields
2823 if (mSize < 1) then raise TDynRecException.CreateFmt('cannot read record of type ''%s'' with unknown size', [mTypeName]);
2827 begin
2830 if (fld.mBinOfs >= st.size) then raise TDynRecException.CreateFmt('record of type ''%s'' has invalid field ''%s''', [fld.mName]);
2832 //writeln('parsing ''', mName, '.', fld.mName, '''...');
2835 // fix default values
2837 begin
2841 finally
2848 procedure TDynRecord.writeBinTo (var hasLostData: Boolean; st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
2849 var
2857 begin
2859 begin
2860 if (mBinBlock < 1) then raise TDynRecException.Create('cannot write binary record without block number');
2863 end
2864 else
2865 begin
2868 try
2873 // write normal fields
2875 begin
2876 // record list?
2880 begin
2882 continue;
2884 if (fld.mBinOfs >= bufsz) then raise TDynRecException.Create('binary value offset is outside of the buffer');
2886 //writeln('writing field <', fld.mName, '>');
2890 // write block with normal fields
2892 begin
2893 //writeln('writing header...');
2894 // signature and version
2905 // write other blocks, if any
2907 begin
2908 // calculate blkmax
2911 begin
2912 // record list?
2914 begin
2922 // write blocks
2924 begin
2928 begin
2929 // record list?
2931 begin
2940 // flush block
2942 begin
2953 // write end marker
2958 finally
2966 var
2971 begin
2973 begin
2980 try
2982 begin
2983 // record list?
2985 begin
2988 begin
2991 begin
2994 begin
2997 begin
3007 end
3008 else
3009 begin
3016 continue;
3023 finally
3031 {$IF DEFINED(D2D_DYNREC_PROFILER)}
3032 var
3043 begin
3045 writeln('record cloning: ', profCloneRec div 1000, '.', profCloneRec mod 1000, ' milliseconds');
3046 writeln('findRecType : ', profFindRecType div 1000, '.', profFindRecType mod 1000, ' milliseconds');
3047 writeln('field[] : ', profFieldSearching div 1000, '.', profFieldSearching mod 1000, ' milliseconds');
3048 writeln('list dup check: ', profListDupChecking div 1000, '.', profListDupChecking mod 1000, ' milliseconds');
3049 writeln('addRecByType : ', profAddRecByType div 1000, '.', profAddRecByType mod 1000, ' milliseconds');
3050 writeln('field valparse: ', profFieldValParsing div 1000, '.', profFieldValParsing mod 1000, ' milliseconds');
3051 writeln('fix defaults : ', profFixDefaults div 1000, '.', profFixDefaults mod 1000, ' milliseconds');
3052 writeln('recvalparse : ', profRecValParse div 1000, '.', profRecValParse mod 1000, ' milliseconds');
3054 {$ENDIF}
3058 var
3062 {$IF DEFINED(D2D_DYNREC_PROFILER)}
3064 {$ENDIF}
3067 var
3070 begin
3071 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
3073 begin
3075 begin
3077 continue;
3083 begin
3084 //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);
3085 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]);
3087 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
3093 begin
3094 //writeln(' ', fld.mName);
3099 begin
3100 if (mOwner = nil) then raise TDynParseException.CreateFmt(pr, 'can''t parse record ''%s'' value without owner', [mTypeName]);
3104 // not a header?
3106 begin
3107 // id?
3109 end
3110 else
3111 begin
3115 //writeln('parsing record <', mName, '>');
3118 begin
3120 //writeln('<', mName, '.', pr.tokStr, '>');
3122 // records
3124 begin
3125 // add records with this type (if any)
3130 begin
3135 // on error, it will be freed by memowner
3141 continue;
3145 // fields
3147 //writeln('0: <', mName, '.', pr.tokStr, '>');
3149 //writeln('1: <', mName, '.', pr.tokStr, '>');
3152 begin
3153 //writeln('2: <', mName, '.', pr.tokStr, '>');
3154 if fld.defined then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in record ''%s''', [fld.mName, mTypeName]);
3155 if fld.internal then raise TDynParseException.CreateFmt(pr, 'internal field ''%s'' in record ''%s''', [fld.mName, mTypeName]);
3157 //writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType);
3161 continue;
3164 // something is wrong
3165 raise TDynParseException.CreateFmt(pr, 'unknown field ''%s'' in record ''%s''', [pr.tokStr, mTypeName]);
3170 begin
3171 // link fields
3173 begin
3179 // fix field defaults
3183 //writeln('done parsing record <', mName, '>');
3184 //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', getTimeMicro()-stall);{$ENDIF}
3189 // ////////////////////////////////////////////////////////////////////////// //
3191 begin
3198 begin
3205 begin
3218 begin
3221 begin
3230 begin
3236 var
3238 begin
3245 var
3247 begin
3251 // fields
3254 begin
3258 begin
3262 end
3263 else
3264 begin
3269 // max field
3276 var
3278 begin
3280 // fields
3282 begin
3289 var
3291 begin
3293 begin
3301 var
3307 begin
3315 begin
3317 begin
3318 if (Length(mTip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for enum/bitset ''%s''', [mTypeName]);
3320 continue;
3323 begin
3324 if (Length(mHelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate help definition for enum/bitset ''%s''', [mTypeName]);
3326 continue;
3328 break;
3332 begin
3335 begin
3336 if StrEqu(mIds[f], idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3338 if StrEqu(mMaxName, idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3342 // has value?
3344 begin
3346 begin
3347 if (Length(mMaxName) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3350 end
3351 else
3352 begin
3358 // append it?
3360 begin
3361 // fix maxvalue
3363 begin
3370 // next cv
3372 begin
3381 // add max field
3383 begin
3392 // ////////////////////////////////////////////////////////////////////////// //
3394 begin
3403 var
3406 begin
3407 //!!!FIXME!!! check who owns trigs and recs!
3422 begin
3429 var
3431 begin
3433 begin
3441 var
3443 begin
3445 begin
3453 var
3455 begin
3457 begin
3465 var
3470 // setup header links and type links
3472 var
3474 begin
3477 begin
3482 begin
3484 if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]);
3488 begin
3490 if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]);
3491 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]);
3497 // setup default values
3499 var
3501 begin
3505 begin
3508 begin
3512 begin
3513 // enum or bitset
3515 begin
3518 begin
3524 //writeln(eb.definition); writeln;
3525 continue;
3528 // triggerdata
3530 begin
3533 begin
3535 begin
3542 //writeln(dr.definition); writeln;
3543 continue;
3548 //writeln(dr.definition); writeln;
3549 if (findRecType(rec.typeName) <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
3550 if (hdr <> nil) and StrEqu(rec.typeName, hdr.typeName) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
3553 begin
3554 if (hdr <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate header record ''%s'' (previous is ''%s'')', [rec.typeName, hdr.typeName]); end;
3556 end
3557 else
3558 begin
3563 // put header record to top
3564 if (hdr = nil) then raise TDynParseException.Create(pr, 'header definition not found in mapdef');
3569 // setup header links and type links
3573 // setup default values
3579 // ////////////////////////////////////////////////////////////////////////// //
3581 var
3583 begin
3585 try
3592 finally
3599 var
3601 begin
3603 try
3609 finally
3615 // WARNING! stream must be seekable
3617 var
3620 begin
3626 begin
3628 begin
3631 exit;
3634 end
3635 else
3636 begin
3638 try
3639 try
3644 finally
3651 // returns `true` if the given stream can be a map file
3652 // stream position is 0 on return
3653 // WARNING! stream must be seekable
3655 var
3658 begin
3663 begin
3665 end
3666 else
3667 begin
3678 var
3680 begin
3682 result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
3689 function TDynMapDef.getRecTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < recTypes.count) then result := recTypes[idx] else result := nil; end;
3692 function TDynMapDef.getEBSTypeAt (idx: Integer): TDynEBS; inline; begin if (idx >= 0) and (idx < ebsTypes.count) then result := ebsTypes[idx] else result := nil; end;
3694 function TDynMapDef.getTrigTypeCount (): Integer; inline; begin result := trigTypes.count; end;
3695 function TDynMapDef.getTrigTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < trigTypes.count) then result := trigTypes[idx] else result := nil; end;