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}
19 interface
21 uses
22 Classes,
26 // ////////////////////////////////////////////////////////////////////////// //
27 type
31 // this is base type for all scalars (and arrays)
33 public
34 type
35 TType = (TBool, TChar, TByte, TUByte, TShort, TUShort, TInt, TUInt, TString, TPoint, TSize, TList, TTrigData);
36 // TPoint: pair of Shorts
37 // TSize: pair of UShorts
38 // TList: actually, array of records
39 // TTrigData: array of bytes
40 // arrays of chars are pascal shortstrings (with counter in the first byte)
42 type
46 private
47 type
50 private
71 // default value
79 // temp
82 private
87 procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef`
91 public
108 // won't work for lists
113 public
121 //property list: TDynRecordArray read mRVal write mRVal;
137 // "value" header record contains TList fields, with name equal to record type
139 private
149 mHeaderRec: TDynRecord; // for "value" records this is header record with data, for "type" records this is header type record
151 private
161 protected
166 public
181 public
195 private
204 private
213 public
219 public
228 public
233 private
238 public
246 // creates new header record
249 // creates new header record
252 public
257 implementation
259 uses
260 SysUtils,
261 utils;
264 // ////////////////////////////////////////////////////////////////////////// //
266 begin
276 begin
283 begin
290 begin
321 var
323 begin
357 // won't work for lists
359 begin
383 var
385 begin
387 try
389 finally
396 var
402 begin
404 begin
409 end
410 else
411 begin
417 try
424 finally
436 // default value should be parsed
438 begin
441 begin
443 raise Exception.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mName]));
446 begin
448 {
449 if (mDefRecRef <> nil) then
450 begin
451 rec := mDefRecRef.clone();
452 rec.mHeaderRec := mOwner.mHeaderRec;
453 try
454 mOwner.addRecordByType(mEBSTypeName, rec);
455 mRecRef := rec;
456 rec := nil;
457 finally
458 rec.Free();
459 end;
460 end;
461 }
470 // default value should be parsed
472 begin
485 begin
506 begin
515 TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
519 begin
520 if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
521 else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
529 var
546 begin
567 // field name
570 // field type
574 // fixed-size array?
576 begin
578 if (lmaxdim < 1) then raise Exception.Create(Format('invali field ''%s'' array size', [fldname]));
583 begin
585 begin
586 if (fldofs >= 0) then raise Exception.Create(Format('duplicate field ''%s'' offset', [fldname]));
589 continue;
593 begin
599 continue;
603 begin
605 if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
607 continue;
611 begin
613 if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
616 continue;
620 begin
621 if hasdefStr or hasdefInt or hasdefId then raise Exception.Create(Format('field ''%s'' has duplicate default', [fldname]));
624 begin
629 begin
634 begin
638 else
641 continue;
645 begin
647 continue;
651 begin
653 continue;
656 if (pr.tokType <> pr.TTId) then raise Exception.Create(Format('field ''%s'' has something unexpected in definition', [fldname]));
658 if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
665 // create field
680 else raise Exception.Create(Format('field ''%s'' has invalid type ''%s''', [fldname, fldtype]));
699 //if mHasDefault then parseDefaultValue();
704 var
710 begin
714 begin
716 begin
717 // this must be triggerdata
719 begin
720 raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
722 // write triggerdata
725 else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
727 //writeln('trigdata size: ', mMaxDim);
729 if (buf = nil) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
730 try
733 begin
738 finally
742 exit;
745 begin
746 // no ref, write -1
751 else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
753 exit;
762 else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
764 // find record number
766 if (f < 0) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]));
767 if (f > maxv) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]));
772 else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
774 exit;
783 begin
785 exit;
788 begin
789 if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
791 begin
792 if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
794 end
795 else
796 begin
797 if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
802 exit;
806 begin
807 // triggerdata array was processed earlier
808 if (mMaxDim >= 0) then Exception.Create(Format('byte array in field ''%s'' cannot be written', [mName]));
810 exit;
814 begin
815 if (mMaxDim >= 0) then raise Exception.Create(Format('short array in field ''%s'' cannot be written', [mName]));
817 exit;
821 begin
822 if (mMaxDim >= 0) then raise Exception.Create(Format('int array in field ''%s'' cannot be written', [mName]));
824 exit;
827 begin
832 begin
833 if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
836 exit;
839 begin
841 exit;
844 begin
846 exit;
854 var
859 begin
862 // if this field should contain struct, convert type and parse struct
866 begin
868 begin
870 end
872 begin
874 end
875 else
876 begin
880 exit;
883 begin
886 if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
888 begin
890 begin
893 exit;
896 raise Exception.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]));
899 begin
902 if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
903 // none?
905 begin
907 begin
909 begin
912 exit;
915 raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]));
917 // not none
921 begin
923 begin
926 begin
928 begin
932 break;
935 if not found then raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]));
940 exit;
947 begin
949 exit;
952 begin
953 if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
956 exit;
964 begin
966 exit;
969 begin
972 exit;
976 begin
978 exit;
981 begin
983 exit;
986 begin
988 exit;
999 begin
1001 if (mIVal < min) or (mIVal > max) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1005 var
1010 begin
1011 // if this field should contain struct, convert type and parse struct
1015 begin
1016 // ugly hack. sorry.
1018 begin
1020 // find trigger definition
1022 if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName]));
1023 if (tfld.mEBS <> TEBS.TEnum) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' with bad ''type'' field', [mName, rec.mName]));
1025 if (rc = nil) then raise Exception.Create(Format('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal]));
1031 exit;
1033 // other record types
1035 begin
1037 begin
1039 end
1040 else
1041 begin
1043 if (rec = nil) then raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSTypeName, mName]));
1049 exit;
1050 end
1052 begin
1054 if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1062 exit;
1067 begin
1069 if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1071 if not es.has[tk] then raise Exception.Create(Format('record enum value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName]));
1074 //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
1077 exit;
1080 begin
1082 if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1085 begin
1087 if not es.has[tk] then raise Exception.Create(Format('record bitset value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName]));
1091 if mBitSetUnique then raise Exception.Create(Format('record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]));
1092 //pr.expectDelim('|');
1097 exit;
1104 begin
1110 exit;
1113 begin
1114 if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1117 begin
1118 // single char
1119 if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
1122 end
1123 else
1124 begin
1125 // string
1126 if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
1130 exit;
1133 begin
1136 exit;
1139 begin
1142 exit;
1145 begin
1148 exit;
1151 begin
1154 exit;
1157 begin
1160 exit;
1163 begin
1166 exit;
1169 begin
1173 exit;
1177 begin
1181 begin
1182 if (mIVal < -32768) or (mIVal > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1183 end
1184 else
1185 begin
1186 if (mIVal < 0) or (mIVal > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1190 begin
1191 if (mIVal2 < -32768) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1192 end
1193 else
1194 begin
1195 if (mIVal2 < 0) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1200 exit;
1203 begin
1205 exit;
1208 begin
1210 exit;
1219 begin
1223 // ////////////////////////////////////////////////////////////////////////// //
1225 begin
1226 if (pr = nil) then raise Exception.Create('cannot create record type without type definition');
1240 begin
1251 begin
1261 begin
1264 begin
1273 begin
1279 var
1281 begin
1288 begin
1294 var
1296 begin
1304 var
1306 begin
1318 begin
1328 var
1331 begin
1334 // find record data
1337 if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]));
1338 // find by id
1340 begin
1343 // alas
1347 function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
1348 var
1351 begin
1353 // find record data
1356 if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]));
1357 // find by ref
1359 begin
1362 // alas
1367 var
1369 begin
1370 // find record data
1373 begin
1374 // first record
1380 if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename]));
1381 // append
1388 var
1391 begin
1393 begin
1396 begin
1398 begin
1402 if isForTrig[tdn] then raise Exception.Create(Format('duplicate trigdata ''%s'' trigtype ''%s''', [mName, tdn]));
1406 end
1407 else
1408 begin
1413 end
1414 else
1415 begin
1420 begin
1423 begin
1424 if (mSize > 0) then raise Exception.Create(Format('duplicate `size` in record ''%s''', [mName]));
1426 if (mSize < 1) then raise Exception.Create(Format('invalid record ''%s'' size: %d', [mName, mSize]));
1428 continue;
1431 begin
1432 if (mBinBlock >= 0) then raise Exception.Create(Format('duplicate `binblock` in record ''%s''', [mName]));
1434 if (mBinBlock < 1) then raise Exception.Create(Format('invalid record ''%s'' binblock: %d', [mName, mBinBlock]));
1435 continue;
1441 // load fields
1443 begin
1445 if hasByName(fld.name) then begin fld.Free(); raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); end;
1446 // append
1450 // done with field
1451 //writeln('DEF: ', fld.definition);
1458 var
1460 begin
1462 begin
1463 // trigger data
1466 begin
1469 begin
1474 end
1475 else
1476 begin
1479 end
1480 else
1481 begin
1482 // record
1489 begin
1499 var
1508 begin
1510 begin
1511 if (mBinBlock < 1) then raise Exception.Create('cannot write binary record without block number');
1514 end
1515 else
1516 begin
1519 try
1524 // write normal fields
1526 begin
1528 // record list?
1532 if (fld.mBinOfs >= bufsz) then raise Exception.Create('binary value offset is outside of the buffer');
1534 //writeln('writing field <', fld.mName, '>');
1538 // write block with normal fields
1540 begin
1542 // signature and version
1553 // write other blocks, if any
1555 begin
1556 // calculate blkmax
1559 begin
1561 // record list?
1563 begin
1571 // write blocks
1573 begin
1577 begin
1579 // record list?
1581 begin
1587 //rec.writeBinTo(ws);
1591 // flush block
1593 begin
1605 finally
1613 var
1616 begin
1618 begin
1625 try
1627 begin
1629 // record list?
1631 begin
1634 begin
1639 continue;
1646 finally
1655 var
1659 //success: Boolean;
1660 begin
1661 if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName]));
1663 // not a header?
1665 begin
1666 // id?
1668 end
1669 else
1670 begin
1674 //writeln('parsing record <', mName, '>');
1677 begin
1679 //writeln('<', pr.tokStr, ':', asheader, '>');
1681 // records
1683 begin
1684 // add records with this type (if any)
1687 begin
1690 try
1694 begin
1697 begin
1699 begin
1700 if (Length(fld.mRVal[c].mId) > 0) and (CompareText(fld.mRVal[c].mId, rec.mId) = 0) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
1706 finally
1709 continue;
1713 // fields
1716 begin
1717 if fld.defined then raise Exception.Create(Format('duplicate field ''%s'' in record ''%s''', [fld.mName, mName]));
1718 if fld.internal then raise Exception.Create(Format('internal field ''%s'' in record ''%s''', [fld.mName, mName]));
1721 continue;
1724 // something is wrong
1728 // fix field defaults
1730 //writeln('done parsing record <', mName, '>');
1735 begin
1739 // ////////////////////////////////////////////////////////////////////////// //
1741 begin
1748 begin
1755 begin
1766 begin
1769 begin
1778 begin
1784 var
1786 begin
1793 var
1795 begin
1799 // fields
1802 begin
1806 begin
1810 end
1811 else
1812 begin
1817 // max field
1824 var
1830 begin
1839 begin
1842 begin
1843 if (CompareText(mIds[f], idname) = 0) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
1845 if (CompareText(mMaxName, idname) = 0) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
1849 // has value?
1851 begin
1853 begin
1854 if (Length(mMaxName) > 0) then raise Exception.Create(Format('duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mName]));
1857 end
1858 else
1859 begin
1865 // append it?
1867 begin
1868 // fix maxvalue
1870 begin
1877 // next cv
1879 begin
1888 // add max field
1890 begin
1899 // ////////////////////////////////////////////////////////////////////////// //
1901 begin
1910 var
1912 begin
1924 begin
1931 var
1933 begin
1935 begin
1943 var
1945 begin
1947 begin
1955 var
1957 begin
1959 begin
1967 var
1971 begin
1974 begin
1979 begin
1982 begin
1989 //writeln(eb.definition); writeln;
1990 continue;
1994 begin
1997 begin
1999 begin
2007 //writeln(dr.definition); writeln;
2008 continue;
2012 //writeln(dr.definition); writeln;
2013 if (findRecType(dr.name) <> nil) then begin dr.Free(); raise Exception.Create(Format('duplicate record ''%s''', [dr.name])); end;
2014 if (hdr <> nil) and (CompareText(dr.name, hdr.name) = 0) then begin dr.Free(); raise Exception.Create(Format('duplicate record ''%s''', [dr.name])); end;
2017 begin
2018 if (hdr <> nil) then begin dr.Free(); raise Exception.Create(Format('duplicate header record ''%s'' (previous is ''%s'')', [dr.name, hdr.name])); end;
2020 end
2021 else
2022 begin
2028 // put header record to top
2034 // setup header links
2037 // setup default values
2039 begin
2041 begin
2048 // ////////////////////////////////////////////////////////////////////////// //
2050 var
2052 begin
2054 try
2062 begin
2071 begin