summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: ae649f7)
raw | patch | inline | side by side (parent: ae649f7)
| author | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
| Wed, 6 Sep 2017 22:34:04 +0000 (01:34 +0300) | ||
| committer | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
| Wed, 6 Sep 2017 22:34:47 +0000 (01:34 +0300) |
diff --git a/src/game/g_map.pas b/src/game/g_map.pas
index 33571b8bcd182fb5b61cbae55bfabfcd3c9f4a33..caedf4bbaf1e2425ad100c73f637dc556d2a84d9 100644 (file)
--- a/src/game/g_map.pas
+++ b/src/game/g_map.pas
try
dfmapdef := TDynMapDef.Create(pr);
- except on e: Exception do
- raise Exception.Create(Format('ERROR in "mapdef.txt" at (%s,%s): %s', [pr.line, pr.col, e.message]));
+ except
+ on e: TDynParseException do
+ raise Exception.CreateFmt('ERROR in "mapdef.txt" at (%s,%s): %s', [e.tokLine, e.tokCol, e.message]);
+ on e: Exception do
+ raise Exception.CreateFmt('ERROR in "mapdef.txt" at (%s,%s): %s', [pr.tokLine, pr.tokCol, e.message]);
end;
st.Free();
function g_Map_ParseMap (data: Pointer; dataLen: Integer): TDynRecord;
var
wst: TSFSMemoryChunkStream = nil;
- pr: TTextParser = nil;
begin
result := nil;
if (dataLen < 4) then exit;
if (dfmapdef = nil) then raise Exception.Create('internal map loader error');
wst := TSFSMemoryChunkStream.Create(data, dataLen);
-
- if (PAnsiChar(data)[0] = 'M') and (PAnsiChar(data)[1] = 'A') and (PAnsiChar(data)[2] = 'P') and (PByte(data)[3] = 1) then
- begin
- // binary map
- try
- //e_LogWriteln('parsing binary map...');
- result := dfmapdef.parseBinMap(wst);
- except on e: Exception do
+ try
+ result := dfmapdef.parseMap(wst);
+ except
+ on e: TDynParseException do
begin
- e_LogWritefln('ERROR: %s', [e.message]);
+ e_LogWritefln('ERROR at (%s,%s): %s', [e.tokLine, e.tokCol, e.message]);
wst.Free();
result := nil;
exit;
end;
- end;
- wst.Free();
- end
- else
- begin
- // text map
- pr := TFileTextParser.Create(wst);
- try
- //e_LogWriteln('parsing text map...');
- result := dfmapdef.parseMap(pr);
- except on e: Exception do
+ on e: Exception do
begin
- if (pr <> nil) then e_LogWritefln('ERROR at (%s,%s): %s', [pr.tokLine, pr.tokCol, e.message])
- else e_LogWritefln('ERROR: %s', [e.message]);
- pr.Free(); // will free `wst`
+ e_LogWritefln('ERROR: %s', [e.message]);
+ wst.Free();
result := nil;
exit;
end;
- end;
- pr.Free(); // will free `wst`
end;
+
//e_LogWriteln('map parsed.');
end;
moveSpeed := rec.moveSpeed;
//moveStart := rec.moveStart;
//moveEnd := rec.moveEnd;
- //moveActive := rec['move_active'].varvalue;
+ //moveActive := rec['move_active'].value;
if not moveSpeed.isZero then
begin
SetLength(gMovingWallIds, Length(gMovingWallIds)+1);
diff --git a/src/game/g_panel.pas b/src/game/g_panel.pas
index 55190ae2b7dd52d5847d2599501dd457f2b4796b..b43a6683f751e828b9d7d2e94f21918af4fe402e 100644 (file)
--- a/src/game/g_panel.pas
+++ b/src/game/g_panel.pas
mMovingSpeed := PanelRec.moveSpeed;
mMovingStart := PanelRec.moveStart;
mMovingEnd := PanelRec.moveEnd;
- mMovingActive := PanelRec['move_active'].varvalue;
+ mMovingActive := PanelRec['move_active'].value;
mOldMovingActive := mMovingActive;
mMoveOnce := PanelRec.moveOnce;
index cf039ba3913cddd0cc29331efe034f57377e3861..7c44d9839ebe3c9013fb0881850c9f979cc97e23 100644 (file)
--- a/src/game/g_triggers.pas
+++ b/src/game/g_triggers.pas
triggers := gCurrentMap['trigger'];
if (triggers = nil) then raise Exception.Create('LOAD: map has no triggers');
if (mapidx < 0) or (mapidx >= triggers.count) then raise Exception.Create('LOAD: invalid map trigger index');
- Trigger.trigData := triggers.item[mapidx];
+ Trigger.trigData := triggers.itemAt[mapidx];
if (Trigger.trigData = nil) then raise Exception.Create('LOAD: internal error in trigger loader');
Trigger.mapId := Trigger.trigData.id;
Trigger.mapIndex := mapidx;
diff --git a/src/shared/MAPDEF.pas b/src/shared/MAPDEF.pas
index 4f4a3cdd0859e2d07c7c9bef845684be16b5cd8f..ecfad90a9710b2acbf0d8d79cce801f7d1a2de92 100644 (file)
--- a/src/shared/MAPDEF.pas
+++ b/src/shared/MAPDEF.pas
begin
fld := field['userPanelId'];
//if (fld = nil) or (fld.baseType <> TDynField.TType.TInt) then result := -1 else result := fld.ival;
- if (fld = nil) then result := -1 else result := Integer(fld.varvalue);
+ if (fld = nil) then result := -1 else result := Integer(fld.value);
end;
fld: TDynField;
begin
fld := field['userPanelTrigRef'];
- if (fld = nil) then result := false else result := Boolean(fld.varvalue);
+ if (fld = nil) then result := false else result := Boolean(fld.value);
//if (fld = nil) or (fld.baseType <> TDynField.TType.TBool) then result := false else result := (fld.ival <> 0);
end;
function TDynRecordHelper.getFieldWithType (const aname: AnsiString; atype: TDynField.TType): TDynField; inline;
begin
result := field[aname];
- if (result = nil) then raise Exception.Create(Format('field ''%s'' not found in record ''%s'' of type ''%s''', [aname, name, id]));
- if (result.baseType <> atype) then raise Exception.Create(Format('field ''%s'' in record ''%s'' of type ''%s'' has invalid data type', [aname, name, id]));
+ if (result = nil) then raise Exception.Create(Format('field ''%s'' not found in record ''%s'' of type ''%s''', [aname, typeName, id]));
+ if (result.baseType <> atype) then raise Exception.Create(Format('field ''%s'' in record ''%s'' of type ''%s'' has invalid data type', [aname, typeName, id]));
end;
fld: TDynField;
begin
fld := field[aname];
- if (fld = nil) then raise Exception.Create(Format('field ''%s'' not found in record ''%s'' of type ''%s''', [aname, name, id]));
- if (fld.baseType <> TPoint) then raise Exception.Create(Format('field ''%s'' in record ''%s'' of type ''%s'' has invalid data type', [aname, name, id]));
+ if (fld = nil) then raise Exception.Create(Format('field ''%s'' not found in record ''%s'' of type ''%s''', [aname, typeName, id]));
+ if (fld.baseType <> TPoint) then raise Exception.Create(Format('field ''%s'' in record ''%s'' of type ''%s'' has invalid data type', [aname, typeName, id]));
result := TDFPoint.Create(fld.ival, fld.ival2);
end;
fld: TDynField;
begin
fld := field[aname];
- if (fld = nil) then raise Exception.Create(Format('field ''%s'' not found in record ''%s'' of type ''%s''', [aname, name, id]));
- if (fld.baseType <> TSize) and (fld.baseType <> TPoint) then raise Exception.Create(Format('field ''%s'' in record ''%s'' of type ''%s'' has invalid data type', [aname, name, id]));
+ if (fld = nil) then raise Exception.Create(Format('field ''%s'' not found in record ''%s'' of type ''%s''', [aname, typeName, id]));
+ if (fld.baseType <> TSize) and (fld.baseType <> TPoint) then raise Exception.Create(Format('field ''%s'' in record ''%s'' of type ''%s'' has invalid data type', [aname, typeName, id]));
result := TDFSize.Create(fld.ival, fld.ival2);
end;
fld: TDynField;
begin
fld := headerRec['panel'];
- if (fld <> nil) then result := fld.item[idx] else result := nil;
+ if (fld <> nil) then result := fld.itemAt[idx] else result := nil;
end;
fld := headerRec['panel'];
if (fld <> nil) then
begin
- for f := 0 to fld.count-1 do if (fld.item[f] = pan) then begin result := f; exit; end;
+ for f := 0 to fld.count-1 do if (fld.itemAt[f] = pan) then begin result := f; exit; end;
end;
end;
end;
diff --git a/src/shared/utils.pas b/src/shared/utils.pas
index f61035e5c4ac6a6fbf736df86b64e53901c4550e..43bdc8f015faa59bc00523c1eac0b583ad9c996b 100644 (file)
--- a/src/shared/utils.pas
+++ b/src/shared/utils.pas
TFormatStrFCallback = procedure (constref buf; len: SizeUInt);
// returns formatted string if `writerCB` is `nil`, empty string otherwise
-function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
+function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
function wchar2win (wc: WideChar): AnsiChar; inline;
function utf2win (const s: AnsiString): AnsiString;
*)
-function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
+function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
const
PadSpaces: AnsiString = ' ';
PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000';
index 69d04394ceaeacd10c077c149852d82dd8a210a7..96bf2293b01bff634f722032f9e225e7948019bd 100644 (file)
--- a/src/shared/wadreader.pas
+++ b/src/shared/wadreader.pas
implementation
uses
- SysUtils, e_log, utils, MAPDEF;
+ SysUtils, e_log, utils, MAPDEF, xdynrec;
function findDiskWad (fname: AnsiString): AnsiString;
//FIXME: detect text maps properly here
function TWADFile.isMapResource (idx: Integer): Boolean;
var
- sign: packed array [0..2] of Char;
+ //sign: packed array [0..2] of Char;
fs: TStream = nil;
begin
result := false;
if (idx < 0) or (idx >= fIter.Count) then exit;
try
fs := fIter.volume.OpenFileByIndex(idx);
+ result := TDynMapDef.canBeMap(fs);
+ (*
fs.readBuffer(sign, 3);
result := (sign = MAP_SIGNATURE);
if not result then result := (sign[0] = 'm') and (sign[1] = 'a') and (sign[2] = 'p');
+ *)
except
- if fs <> nil then fs.Free();
+ fs.Free();
+ result := false; // just in case
exit;
end;
fs.Free();
fs: TStream;
fpp: Pointer;
rpath, rname: AnsiString;
- sign: packed array [0..2] of Char;
+ //sign: packed array [0..2] of Char;
goodMap: Boolean;
+ {$IFNDEF SFS_MAPDETECT_FX}
+ wst: TSFSMemoryChunkStream;
+ {$ENDIF}
begin
Result := False;
if not isOpen or (fIter = nil) then Exit;
e_LogWritefln('DFWAD: checking for good map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]);
{$ENDIF}
try
- fs.readBuffer(sign, 3);
- goodMap := (sign = MAP_SIGNATURE);
- if not goodMap then goodMap := (sign[0] = 'm') and (sign[1] = 'a') and (sign[2] = 'p');
+ //fs.readBuffer(sign, 3);
+ //goodMap := (sign = MAP_SIGNATURE);
+ //if not goodMap then goodMap := (sign[0] = 'm') and (sign[1] = 'a') and (sign[2] = 'p');
+ goodMap := TDynMapDef.canBeMap(fs);
{$IF DEFINED(D2D_NEW_MAP_READER_DBG)}
if goodMap then
e_LogWritefln(' GOOD map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f])
goodMap := false;
if Len >= 3 then
begin
- Move(pData^, sign, 3);
- goodMap := (sign = MAP_SIGNATURE);
+ //Move(pData^, sign, 3);
+ //goodMap := (sign = MAP_SIGNATURE);
+ wst := TSFSMemoryChunkStream.Create(pData, Len);
+ try
+ goodMap := TDynMapDef.canBeMap(wst);
+ except
+ goodMap := false;
+ end;
+ wst.Free();
end;
if not goodMap then
begin
diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas
index 3bce723917354b4ad0e119cf92edcba521f42e2d..6c4e376194b85e63beb7f3572b4cd389a5446e3e 100644 (file)
--- a/src/shared/xdynrec.pas
+++ b/src/shared/xdynrec.pas
interface
uses
- Variants, Classes,
+ SysUtils, Variants, Classes,
xparser, xstreams, utils, hashtable;
+// ////////////////////////////////////////////////////////////////////////// //
+type
+ TDynRecException = class(Exception)
+ public
+ constructor Create (const amsg: AnsiString);
+ constructor CreateFmt (const afmt: AnsiString; const args: array of const);
+ end;
+
+ TDynParseException = class(TDynRecException)
+ public
+ tokLine, tokCol: Integer;
+
+ public
+ constructor Create (pr: TTextParser; const amsg: AnsiString);
+ constructor CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
+ end;
+
+
// ////////////////////////////////////////////////////////////////////////// //
type
TDynMapDef = class;
private
procedure cleanup ();
- procedure parseDef (pr: TTextParser);
-
procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef`
procedure fixDefaultValue (); // this will NOT clone `mDefRecRef`
function isDefaultValue (): Boolean;
function getRecRefIndex (): Integer;
- procedure setIVal (v: Integer); inline;
-
function getVar (): Variant;
procedure setVar (val: Variant);
+ procedure setRecRef (arec: TDynRecord);
+
+ procedure parseDef (pr: TTextParser); // parse mapdef definition
+ function definition (): AnsiString; // generate mapdef definition
+
protected
// returns `true` for duplicate record id
function addListItem (rec: TDynRecord): Boolean; inline;
+ public
+ // get string name for the given type
+ class function getTypeName (t: TType): AnsiString;
+
public
constructor Create (const aname: AnsiString; atype: TType);
- constructor Create (pr: TTextParser);
constructor Create (const aname: AnsiString; val: Variant);
+ constructor Create (pr: TTextParser);
destructor Destroy (); override;
- class function getTypeName (t: TType): AnsiString;
+ // clone this field; register all list records in `registerIn`
+ // "registration" is required to manage record lifetime; use header record if in doubt
+ // owner will be set to `newOwner`, if it is not `nil`, or to `owner`
+ // for lists, cloning will clone all list members
+ function clone (newOwner: TDynRecord=nil; registerIn: TDynRecord=nil): TDynField;
- // build "alias name" for pascal code
- function palias (firstUp: Boolean=false): AnsiString;
+ // compare field values (including trigdata)
+ // WARNING: won't work for lists
+ function isSimpleEqu (fld: TDynField): Boolean;
- function definition (): AnsiString;
+ // parse string value to appropriate type and set new field value
+ procedure setValue (const s: AnsiString);
- function clone (newOwner: TDynRecord=nil; registerIn: TDynRecord=nil): TDynField;
+ // supports `for rec in field do` (for lists)
+ function GetEnumerator (): TDynRecList.TEnumerator; inline;
+ public
+ // text parser and writer
procedure parseValue (pr: TTextParser);
- procedure parseBinValue (st: TStream);
-
procedure writeTo (wr: TTextWriter);
+
+ // binary parser and writer (DO NOT USE!)
+ procedure parseBinValue (st: TStream);
procedure writeBinTo (st: TStream);
- // won't work for lists
- function isSimpleEqu (fld: TDynField): Boolean;
+ public
+ // the following functions are here only for 'mapgen'! DO NOT USE!
+ // build "alias name" for pascal code
+ function palias (firstUp: Boolean=false): AnsiString;
- procedure setValue (const s: AnsiString);
+ public
+ property owner: TDynRecord read mOwner;
+ property name: AnsiString read mName; // field name
+ property baseType: TType read mType; // field type (base for arrays)
+ property defined: Boolean read mDefined; // was field value set to something by external code?
+ property internal: Boolean read mInternal write mInternal; // internal field?
+ property ival: Integer read mIVal; // integer value for int field (for speed), first field (x/w) for `TPoint` and `TSize`
+ property ival2: Integer read mIVal2; // for `TPoint` and `TSize`, this is second field (y/h)
+ property sval: AnsiString read mSVal; // string value for string field (for speed)
+ property hasDefault: Boolean read mHasDefault; // `true` if this field has default value in mapdef
+ property defsval: AnsiString read mDefSVal; // string representation of default value
+ property ebs: TEBS read mEBS; // what kind of reference is this? none, enum, bitset, record
+ property ebstype: TObject read mEBSType; // reference type (nil, TDynRecord, TDynEBS); WARNING: don't modify type!
+ property ebstypename: AnsiString read mEBSTypeName; // enum/bitset name
+ property recref: TDynRecord read mRecRef write setRecRef; // referenced record (actual one, you can modify it)
+ property recrefIndex: Integer read getRecRefIndex; // index of referenced record in header; -1: not found
+ // for record lists
+ property count: Integer read getListCount;
+ property itemAt[idx: Integer]: TDynRecord read getListItem;
+ property item[const aname: AnsiString]: TDynRecord read getListItem; default; // alas, FPC 3+ lost property overloading feature
+ // field value as Variant
+ property value: Variant read getVar write setVar;
- function GetEnumerator (): TDynRecList.TEnumerator; inline;
+ public
+ // userdata (you can use these properties as you want to; they won't be written or read to files)
+ property tagInt: Integer read mTagInt write mTagInt;
+ property tagPtr: Pointer read mTagPtr write mTagPtr;
public
- property name: AnsiString read mName;
- property baseType: TType read mType;
+ // the following properties are here only for 'mapgen'! DO NOT USE!
property negbool: Boolean read mNegBool;
- property defined: Boolean read mDefined;
- property internal: Boolean read mInternal write mInternal;
property hasTPrefix: Boolean read mAsT;
property separatePasFields: Boolean read mSepPosSize;
property binOfs: Integer read mBinOfs;
- property ival: Integer read mIVal write setIVal;
- property ival2: Integer read mIVal2;
- property sval: AnsiString read mSVal;
- property hasDefault: Boolean read mHasDefault;
- property defsval: AnsiString read mDefSVal;
- property ebs: TEBS read mEBS;
- property ebstype: TObject read mEBSType;
- property ebstypename: AnsiString read mEBSTypeName; // enum/bitset name
- property recref: TDynRecord read mRecRef;
- property recrefIndex: Integer read getRecRefIndex; // search for this record in header; -1: not found
- // for lists
- property count: Integer read getListCount;
- property item[idx: Integer]: TDynRecord read getListItem;
- property items[const aname: AnsiString]: TDynRecord read getListItem; default; // alas, FPC 3+ lost property overloading feature
- // userdata
- property tagInt: Integer read mTagInt write mTagInt;
- property tagPtr: Pointer read mTagPtr write mTagPtr;
- //
- property varvalue: Variant read getVar write setVar;
end;
- // "value" header record contains TList fields, with name equal to record type
+ // record, either with actual values, or with type definitions
TDynRecord = class
private
mOwner: TDynMapDef;
private
procedure parseDef (pr: TTextParser); // parse definition
+ function definition (): AnsiString;
function findByName (const aname: AnsiString): Integer; inline;
function hasByName (const aname: AnsiString): Boolean; inline;
procedure regrec (rec: TDynRecord);
+ function getUserVar (const aname: AnsiString): Variant;
+ procedure setUserVar (const aname: AnsiString; val: Variant);
+
protected
function findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord;
function findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
constructor Create (pr: TTextParser); // parse definition
destructor Destroy (); override;
- function definition (): AnsiString;
-
+ // clone this record; register all list records in `registerIn`
+ // "registration" is required to manage record lifetime; use header record if in doubt
+ // all fields are cloned too
function clone (registerIn: TDynRecord): TDynRecord;
+ // compare records (values of all fields, including trigdata)
+ // WARNING: won't work for records with list fields
function isSimpleEqu (rec: TDynRecord): Boolean;
+ // find field with `TriggerType` type
+ function trigTypeField (): TDynField;
+
+ // number of records of the given instance
+ function instanceCount (const atypename: AnsiString): Integer;
+
+ // only for headers: create new record with the given type
+ // will return cloned record ready for use, or `nil` on unknown type name
+ function newTypedRecord (const atypename, aid: AnsiString): TDynRecord;
+
+ public
+ // text parser
+ // `beginEaten`: `true` if "{" was eaten
procedure parseValue (pr: TTextParser; beginEaten: Boolean=false);
- procedure parseBinValue (st: TStream; forceData: Boolean=false);
+ // text writer
+ // `putHeader`: `true` to write complete header, otherwise only "{...}"
procedure writeTo (wr: TTextWriter; putHeader: Boolean=true);
- procedure writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
- // find field with `TriggerType` type
- function trigTypeField (): TDynField;
+ // binary parser and writer (DO NOT USE!)
+ procedure parseBinValue (st: TStream; forceData: Boolean=false);
+ procedure writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
- // number of records of the given instance
- function instanceCount (const typename: AnsiString): Integer;
+ public
+ property mapdef: TDynMapDef read mOwner;
+ property id: AnsiString read mId; // record id in text map
+ property typeName: AnsiString read mName; // record type name (like "panel", or "trigger")
+ property has[const aname: AnsiString]: Boolean read hasByName; // do we have field with the given name?
+ property count: Integer read getCount; // number of fields in this record
+ property field[const aname: AnsiString]: TDynField read getFieldByName; default; // get field by name
+ property fieldAt[idx: Integer]: TDynField read getFieldAt; // get field at the given index
+ property isTrigData: Boolean read getIsTrigData; // is this special "TriggerData" record?
+ property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig; // can this "TriggerData" be used for the trigger with the given type?
+ property forTrigCount: Integer read getForTrigCount; // number of trigger type names for "TriggerData"
+ property forTrigAt[idx: Integer]: AnsiString read getForTrigAt; // trigger type name at the given index for "TriggerData"
+ property headerRec: TDynRecord read mHeaderRec; // get header record for this one (header contains all other records, enums, bitsets, etc.)
+ property isHeader: Boolean read mHeader; // is this a header record?
- function getUserVar (const aname: AnsiString): Variant;
- procedure setUserVar (const aname: AnsiString; val: Variant);
+ public
+ // user fields; user can add arbitrary custom fields
+ // by default, any user field will be marked as "internal"
+ // note: you can use this to manipulate non-user fields too
+ property user[const aname: AnsiString]: Variant read getUserVar write setUserVar;
public
- property id: AnsiString read mId; // for map parser
- property name: AnsiString read mName; // record name
- property size: Integer read mSize; // size in bytes
- //property fields: TDynFieldList read mFields;
- property has[const aname: AnsiString]: Boolean read hasByName;
- property count: Integer read getCount;
- property field[const aname: AnsiString]: TDynField read getFieldByName; default;
- property fieldAt[idx: Integer]: TDynField read getFieldAt;
- property isTrigData: Boolean read getIsTrigData;
- property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig;
- property forTrigCount: Integer read getForTrigCount;
- property forTrigAt[idx: Integer]: AnsiString read getForTrigAt;
- property headerRec: TDynRecord read mHeaderRec;
- property isHeader: Boolean read mHeader;
- // userdata
+ // userdata (you can use these properties as you want to; they won't be written or read to files)
property tagInt: Integer read mTagInt write mTagInt;
property tagPtr: Pointer read mTagPtr write mTagPtr;
- // userfields
- property user[const aname: AnsiString]: Variant read getUserVar write setUserVar;
end;
+
+ // bitset/enum definition
TDynEBS = class
private
mOwner: TDynMapDef;
function hasByName (const aname: AnsiString): Boolean; inline;
function getFieldByName (const aname: AnsiString): Integer; inline;
+ function definition (): AnsiString;
+ function pasdef (): AnsiString;
+
public
constructor Create (pr: TTextParser); // parse definition
destructor Destroy (); override;
- function definition (): AnsiString;
- function pasdef (): AnsiString;
-
+ // find name for the given value
// return empty string if not found
function nameByValue (v: Integer): AnsiString;
public
- property name: AnsiString read mName; // record name
- property isEnum: Boolean read mIsEnum;
+ property mapdef: TDynMapDef read mOwner;
+ property typeName: AnsiString read mName; // enum/bitset type name
+ property isEnum: Boolean read mIsEnum; // is this enum? `false` means "bitset"
property has[const aname: AnsiString]: Boolean read hasByName;
property field[const aname: AnsiString]: Integer read getFieldByName;
end;
+ // parsed "mapdef.txt"
TDynMapDef = class
public
recTypes: TDynRecList; // [0] is always header
function getHeaderRecType (): TDynRecord; inline;
+ function getRecTypeCount (): Integer; inline;
+ function getRecTypeAt (idx: Integer): TDynRecord; inline;
+
+ function getEBSTypeCount (): Integer; inline;
+ function getEBSTypeAt (idx: Integer): TDynEBS; inline;
+
function getTrigTypeCount (): Integer; inline;
function getTrigTypeAt (idx: Integer): TDynRecord; inline;
+ // creates new header record
+ function parseTextMap (pr: TTextParser): TDynRecord;
+
+ // creates new header record
+ function parseBinMap (st: TStream): TDynRecord;
+
public
constructor Create (pr: TTextParser); // parses data definition
destructor Destroy (); override;
function findTrigFor (const aname: AnsiString): TDynRecord;
function findEBSType (const aname: AnsiString): TDynEBS;
- function pasdefconst (): AnsiString;
+ public
+ // parse text or binary map, return new header record
+ // WARNING! stream must be seekable
+ function parseMap (st: TStream): TDynRecord;
- // creates new header record
- function parseMap (pr: TTextParser): TDynRecord;
+ // returns `true` if the given stream can be a map file
+ // stream position is 0 on return
+ // WARNING! stream must be seekable
+ class function canBeMap (st: TStream): Boolean;
- // creates new header record
- function parseBinMap (st: TStream): TDynRecord;
+ public
+ // the following functions are here only for 'mapgen'! DO NOT USE!
+ function pasdefconst (): AnsiString;
public
property headerType: TDynRecord read getHeaderRecType;
+ // for record types
+ property recTypeCount: Integer read getRecTypeCount;
+ property recTypeAt[idx: Integer]: TDynRecord read getRecTypeAt;
+ property recType[const aname: AnsiString]: TDynRecord read findRecType;
+ // for enum/bitset types
+ property ebsTypeCount: Integer read getEBSTypeCount;
+ property ebsTypeAt[idx: Integer]: TDynEBS read getEBSTypeAt;
+ property ebsType[const aname: AnsiString]: TDynEBS read findEBSType;
+ // for trigtypes
property trigTypeCount: Integer read getTrigTypeCount;
- property trigType[idx: Integer]: TDynRecord read getTrigTypeAt;
+ property trigTypeAt[idx: Integer]: TDynRecord read getTrigTypeAt;
+ property trigTypeFor[const aname: AnsiString]: TDynRecord read findTrigFor;
end;
implementation
uses
- SysUtils, e_log
+ e_log
{$IF DEFINED(D2D_DYNREC_PROFILER)},xprofiler{$ENDIF};
function StrEqu (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TDynRecException.Create (const amsg: AnsiString);
+begin
+ inherited Create(amsg);
+end;
+
+constructor TDynRecException.CreateFmt (const afmt: AnsiString; const args: array of const);
+begin
+ inherited Create(formatstrf(afmt, args));
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TDynParseException.Create (pr: TTextParser; const amsg: AnsiString);
+begin
+ if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
+ inherited Create(amsg);
+end;
+
+constructor TDynParseException.CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
+begin
+ if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
+ inherited Create(formatstrf(afmt, args));
+end;
+
+
// ////////////////////////////////////////////////////////////////////////// //
function TDynField.GetEnumerator (): TDynRecList.TEnumerator; inline;
begin
TType.TBool:
if (v = 0) then mIVal := 0
else if (v = 1) then mIVal := 1
- else raise Exception.Create('cannot convert shortint variant to field value');
+ else raise TDynRecException.Create('cannot convert shortint variant to field value');
TType.TByte:
if (v >= -128) and (v <= 127) then mIVal := v
- else raise Exception.Create('cannot convert shortint variant to field value');
+ else raise TDynRecException.Create('cannot convert shortint variant to field value');
TType.TUByte:
if (v >= 0) and (v <= 255) then mIVal := v
- else raise Exception.Create('cannot convert shortint variant to field value');
+ else raise TDynRecException.Create('cannot convert shortint variant to field value');
TType.TShort:
if (v >= -32768) and (v <= 32767) then mIVal := v
- else raise Exception.Create('cannot convert shortint variant to field value');
+ else raise TDynRecException.Create('cannot convert shortint variant to field value');
TType.TUShort:
if (v >= 0) and (v <= 65535) then mIVal := v
- else raise Exception.Create('cannot convert shortint variant to field value');
+ else raise TDynRecException.Create('cannot convert shortint variant to field value');
TType.TInt:
mIVal := v;
TType.TUInt:
TType.TString:
mSVal := formatstrf('%s', [v]);
else
- raise Exception.Create('cannot convert integral variant to field value');
+ raise TDynRecException.Create('cannot convert integral variant to field value');
end;
end;
begin
cleanup();
mName := aname;
case varType(val) of
- varEmpty: raise Exception.Create('cannot convert empty variant to field value');
- varNull: raise Exception.Create('cannot convert null variant to field value');
- varSingle: raise Exception.Create('cannot convert single variant to field value');
- varDouble: raise Exception.Create('cannot convert double variant to field value');
- varDecimal: raise Exception.Create('cannot convert decimal variant to field value');
- varCurrency: raise Exception.Create('cannot convert currency variant to field value');
- varDate: raise Exception.Create('cannot convert date variant to field value');
- varOleStr: raise Exception.Create('cannot convert olestr variant to field value');
- varStrArg: raise Exception.Create('cannot convert stdarg variant to field value');
+ varEmpty: raise TDynRecException.Create('cannot convert empty variant to field value');
+ varNull: raise TDynRecException.Create('cannot convert null variant to field value');
+ varSingle: raise TDynRecException.Create('cannot convert single variant to field value');
+ varDouble: raise TDynRecException.Create('cannot convert double variant to field value');
+ varDecimal: raise TDynRecException.Create('cannot convert decimal variant to field value');
+ varCurrency: raise TDynRecException.Create('cannot convert currency variant to field value');
+ varDate: raise TDynRecException.Create('cannot convert date variant to field value');
+ varOleStr: raise TDynRecException.Create('cannot convert olestr variant to field value');
+ varStrArg: raise TDynRecException.Create('cannot convert stdarg variant to field value');
varString: mType := TType.TString;
- varDispatch: raise Exception.Create('cannot convert dispatch variant to field value');
+ varDispatch: raise TDynRecException.Create('cannot convert dispatch variant to field value');
varBoolean: mType := TType.TBool;
- varVariant: raise Exception.Create('cannot convert variant variant to field value');
- varUnknown: raise Exception.Create('cannot convert unknown variant to field value');
+ varVariant: raise TDynRecException.Create('cannot convert variant variant to field value');
+ varUnknown: raise TDynRecException.Create('cannot convert unknown variant to field value');
varByte: mType := TType.TUByte;
varWord: mType := TType.TUShort;
varShortInt: mType := TType.TByte;
varSmallint: mType := TType.TShort;
varInteger: mType := TType.TInt;
- varInt64: raise Exception.Create('cannot convert int64 variant to field value');
- varLongWord: raise Exception.Create('cannot convert longword variant to field value');
- varQWord: raise Exception.Create('cannot convert uint64 variant to field value');
- varError: raise Exception.Create('cannot convert error variant to field value');
- else raise Exception.Create('cannot convert undetermined variant to field value');
+ varInt64: raise TDynRecException.Create('cannot convert int64 variant to field value');
+ varLongWord: raise TDynRecException.Create('cannot convert longword variant to field value');
+ varQWord: raise TDynRecException.Create('cannot convert uint64 variant to field value');
+ varError: raise TDynRecException.Create('cannot convert error variant to field value');
+ else raise TDynRecException.Create('cannot convert undetermined variant to field value');
end;
- varvalue := val;
+ value := val;
end;
end;
-procedure TDynField.setIVal (v: Integer); inline;
+procedure TDynField.setRecRef (arec: TDynRecord);
+var
+ trc: TDynRecord = nil;
begin
- //FIXME: check type
- mIVal := v;
- mDefined := true;
+ case mEBS of
+ TEBS.TNone: raise TDynRecException.CreateFmt('cannot set refrec for non-reference field ''%s''', [mName]);
+ TEBS.TRec:
+ begin
+ if (arec <> nil) then
+ begin
+ if (mEBSType <> nil) and (mEBSType is TDynRecord) then trc := (mEBSType as TDynRecord);
+ if (trc = nil) then raise TDynRecException.CreateFmt('cannot set refrec for field ''%s'' (type conflict: improperly initialized field)', [mName]);
+ 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]);
+ end;
+ mRecRef := arec;
+ mDefined := true;
+ exit;
+ end;
+ TEBS.TEnum: raise TDynRecException.CreateFmt('cannot set refrec for enum field ''%s''', [mName]);
+ TEBS.TBitSet: raise TDynRecException.CreateFmt('cannot set refrec for bitset field ''%s''', [mName]);
+ else raise TDynRecException.Create('ketmar forgot to process some reftypes');
+ end;
end;
TType.TInt: result := LongInt(mIVal);
TType.TUInt: result := LongWord(mIVal);
TType.TString: result := mSVal;
- TType.TPoint: raise Exception.Create('cannot convert point field to variant');
- TType.TSize: raise Exception.Create('cannot convert size field to variant');
- TType.TList: raise Exception.Create('cannot convert list field to variant');
- TType.TTrigData: raise Exception.Create('cannot convert trigdata field to variant');
- else result := Unassigned; raise Exception.Create('ketmar forgot to handle some field type');
+ TType.TPoint: raise TDynRecException.Create('cannot convert point field to variant');
+ TType.TSize: raise TDynRecException.Create('cannot convert size field to variant');
+ TType.TList: raise TDynRecException.Create('cannot convert list field to variant');
+ TType.TTrigData: raise TDynRecException.Create('cannot convert trigdata field to variant');
+ else result := Unassigned; raise TDynRecException.Create('ketmar forgot to handle some field type');
end;
end;
TType.TBool:
if (v = 0) then mIVal := 0
else if (v = 1) then mIVal := 1
- else raise Exception.Create('cannot convert shortint variant to field value');
+ else raise TDynRecException.Create('cannot convert shortint variant to field value');
TType.TByte:
if (v >= -128) and (v <= 127) then mIVal := v
- else raise Exception.Create('cannot convert shortint variant to field value');
+ else raise TDynRecException.Create('cannot convert shortint variant to field value');
TType.TUByte:
if (v >= 0) and (v <= 255) then mIVal := v
- else raise Exception.Create('cannot convert shortint variant to field value');
+ else raise TDynRecException.Create('cannot convert shortint variant to field value');
TType.TShort:
if (v >= -32768) and (v <= 32767) then mIVal := v
- else raise Exception.Create('cannot convert shortint variant to field value');
+ else raise TDynRecException.Create('cannot convert shortint variant to field value');
TType.TUShort:
if (v >= 0) and (v <= 65535) then mIVal := v
- else raise Exception.Create('cannot convert shortint variant to field value');
+ else raise TDynRecException.Create('cannot convert shortint variant to field value');
TType.TInt:
mIVal := v;
TType.TUInt:
TType.TString:
mSVal := formatstrf('%s', [v]);
else
- raise Exception.Create('cannot convert integral variant to field value');
+ raise TDynRecException.Create('cannot convert integral variant to field value');
end;
end;
begin
case varType(val) of
- varEmpty: raise Exception.Create('cannot convert empty variant to field value');
- varNull: raise Exception.Create('cannot convert null variant to field value');
- varSingle: raise Exception.Create('cannot convert single variant to field value');
- varDouble: raise Exception.Create('cannot convert double variant to field value');
- varDecimal: raise Exception.Create('cannot convert decimal variant to field value');
- varCurrency: raise Exception.Create('cannot convert currency variant to field value');
- varDate: raise Exception.Create('cannot convert date variant to field value');
- varOleStr: raise Exception.Create('cannot convert olestr variant to field value');
- varStrArg: raise Exception.Create('cannot convert stdarg variant to field value');
+ varEmpty: raise TDynRecException.Create('cannot convert empty variant to field value');
+ varNull: raise TDynRecException.Create('cannot convert null variant to field value');
+ varSingle: raise TDynRecException.Create('cannot convert single variant to field value');
+ varDouble: raise TDynRecException.Create('cannot convert double variant to field value');
+ varDecimal: raise TDynRecException.Create('cannot convert decimal variant to field value');
+ varCurrency: raise TDynRecException.Create('cannot convert currency variant to field value');
+ varDate: raise TDynRecException.Create('cannot convert date variant to field value');
+ varOleStr: raise TDynRecException.Create('cannot convert olestr variant to field value');
+ varStrArg: raise TDynRecException.Create('cannot convert stdarg variant to field value');
varString:
if (mType = TType.TChar) or (mType = TType.TString) then
begin
end
else
begin
- raise Exception.Create('cannot convert string variant to field value');
+ raise TDynRecException.Create('cannot convert string variant to field value');
end;
- varDispatch: raise Exception.Create('cannot convert dispatch variant to field value');
+ varDispatch: raise TDynRecException.Create('cannot convert dispatch variant to field value');
varBoolean:
case mType of
TType.TBool,
TType.TString:
if val then mSVal := 'true' else mSVal := 'false';
else
- raise Exception.Create('cannot convert boolean variant to field value');
+ raise TDynRecException.Create('cannot convert boolean variant to field value');
end;
- varVariant: raise Exception.Create('cannot convert variant variant to field value');
- varUnknown: raise Exception.Create('cannot convert unknown variant to field value');
+ varVariant: raise TDynRecException.Create('cannot convert variant variant to field value');
+ varUnknown: raise TDynRecException.Create('cannot convert unknown variant to field value');
varByte,
varWord,
varShortInt,
setInt32(val);
varInt64:
if (val < Int64(LongInt($80000000))) or (val > LongInt($7FFFFFFF)) then
- raise Exception.Create('cannot convert boolean variant to field value')
+ raise TDynRecException.Create('cannot convert boolean variant to field value')
else
mIVal := LongInt(val);
varLongWord:
- if (val > LongWord($7FFFFFFF)) then raise Exception.Create('cannot convert longword variant to field value')
+ if (val > LongWord($7FFFFFFF)) then raise TDynRecException.Create('cannot convert longword variant to field value')
else setInt32(Integer(val));
- varQWord: raise Exception.Create('cannot convert uint64 variant to field value');
- varError: raise Exception.Create('cannot convert error variant to field value');
- else raise Exception.Create('cannot convert undetermined variant to field value');
+ varQWord: raise TDynRecException.Create('cannot convert uint64 variant to field value');
+ varError: raise TDynRecException.Create('cannot convert error variant to field value');
+ else raise TDynRecException.Create('cannot convert undetermined variant to field value');
end;
mDefined := true;
end;
if (mRecRef = nil) then begin result := (fld.mRecRef = nil); exit; end;
result := mRecRef.isSimpleEqu(fld.mRecRef);
end;
- else raise Exception.Create('ketmar forgot to handle some field type');
+ else raise TDynRecException.Create('ketmar forgot to handle some field type');
end;
end;
if not mHasDefault then
begin
if mInternal then exit;
- raise Exception.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mName]));
+ raise TDynRecException.CreateFmt('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mName]);
end;
if (mEBS = TEBS.TRec) then mRecRef := mDefRecRef;
mSVal := mDefSVal;
TType.TSize: result := 'size';
TType.TList: result := 'array';
TType.TTrigData: result := 'trigdata';
- else raise Exception.Create('ketmar forgot to handle some field type');
+ else raise TDynRecException.Create('ketmar forgot to handle some field type');
end;
end;
begin
if pr.eatId('type') then
begin
- if (Length(fldtype) > 0) then raise Exception.Create(Format('duplicate type definition for field ''%s''', [fldname]));
+ if (Length(fldtype) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate type definition for field ''%s''', [fldname]);
// field type
fldtype := pr.expectId();
// fixed-size array?
begin
lmaxdim := pr.expectInt();
// arbitrary limits
- if (lmaxdim < 1) or (lmaxdim > 32768) then raise Exception.Create(Format('invalid field ''%s'' array size', [fldname]));
+ if (lmaxdim < 1) or (lmaxdim > 32768) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' array size', [fldname]);
pr.expectDelim(']');
end;
continue;
if pr.eatId('alias') then
begin
- if (Length(xalias) > 0) then raise Exception.Create(Format('duplicate alias definition for field ''%s''', [fldname]));
+ if (Length(xalias) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate alias definition for field ''%s''', [fldname]);
xalias := pr.expectId();
continue;
end;
if pr.eatId('offset') then
begin
- if (fldofs >= 0) then raise Exception.Create(Format('duplicate field ''%s'' offset', [fldname]));
+ if (fldofs >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' offset', [fldname]);
fldofs := pr.expectInt();
- if (fldofs < 0) then raise Exception.Create(Format('invalid field ''%s'' offset', [fldname]));
+ if (fldofs < 0) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' offset', [fldname]);
continue;
end;
else if pr.eatId('txy') then begin asxy := true; ast := true; end
else if pr.eatId('twh') then begin aswh := true; ast := true; end
else if pr.eatId('monsterid') then begin asmonid := true; end
- else raise Exception.Create(Format('invalid field ''%s'' as what?', [fldname]));
+ else raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' as what?', [fldname]);
continue;
end;
if pr.eatId('enum') then
begin
lebs := TDynField.TEBS.TEnum;
- if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
+ if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
fldrecname := pr.expectId();
continue;
end;
if pr.eatId('bitset') then
begin
lebs := TDynField.TEBS.TBitSet;
- if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
+ if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
unique := pr.eatId('unique');
fldrecname := pr.expectId();
continue;
if pr.eatId('default') then
begin
- if hasdefStr or hasdefInt or hasdefId then raise Exception.Create(Format('field ''%s'' has duplicate default', [fldname]));
+ if hasdefStr or hasdefInt or hasdefId then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has duplicate default', [fldname]);
case pr.tokType of
pr.TTStr:
begin
pr.expectDelim(defech);
end;
else
- raise Exception.Create(Format('field ''%s'' has invalid default', [fldname]));
+ raise TDynParseException.CreateFmt(pr, 'field ''%s'' has invalid default', [fldname]);
end;
continue;
end;
end;
// record type, no special modifiers
- if (pr.tokType <> pr.TTId) then raise Exception.Create(Format('field ''%s'' has something unexpected in definition', [fldname]));
+ if (pr.tokType <> pr.TTId) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has something unexpected in definition', [fldname]);
- if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
+ if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
fldrecname := pr.expectId();
lebs := TDynField.TEBS.TRec;
end;
end
else
begin
- if (Length(fldtype) = 0) then raise Exception.Create(Format('field ''%s'' has no type', [fldname]))
- else raise Exception.Create(Format('field ''%s'' has invalid type ''%s''', [fldname, fldtype]));
+ if (Length(fldtype) = 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has no type', [fldname])
+ else raise TDynParseException.CreateFmt(pr, 'field ''%s'' has invalid type ''%s''', [fldname, fldtype]);
end;
end;
// check for valid arrays
- if (lmaxdim > 0) and (mType <> TType.TChar) and (mType <> TType.TTrigData) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot be array', [fldname, fldtype]));
+ 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]);
// check for valid trigdata or record type
if (mType = TType.TTrigData) then
begin
// trigdata
- if (lmaxdim < 1) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot be non-array', [fldname, 'trigdata']));
- if (Length(fldrecname) > 0) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot have another type', [fldname, 'trigdata']));
+ if (lmaxdim < 1) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot be non-array', [fldname, 'trigdata']);
+ if (Length(fldrecname) > 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot have another type', [fldname, 'trigdata']);
lebs := TDynField.TEBS.TRec;
end
else if (Length(fldrecname) > 0) then
// record
if not (mType in [TType.TByte, TType.TUByte, TType.TShort, TType.TUShort, TType.TInt, TType.TUInt]) then
begin
- raise Exception.Create(Format('field ''%s'' of record type ''%s'' cannot have type ''%s''', [fldname, fldrecname, fldtype]));
+ raise TDynParseException.CreateFmt(pr, 'field ''%s'' of record type ''%s'' cannot have type ''%s''', [fldname, fldrecname, fldtype]);
end;
end;
// this must be triggerdata
if (mType <> TType.TTrigData) then
begin
- raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
+ raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
end;
// write triggerdata
GetMem(buf, mMaxDim);
- if (buf = nil) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
+ if (buf = nil) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
try
FillChar(buf^, mMaxDim, 0);
if (mRecRef <> nil) then
TType.TUShort: maxv := 65534;
TType.TInt: maxv := $7fffffff;
TType.TUInt: maxv := $7fffffff;
- else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
+ else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
end;
// find record number
if (mRecRef <> nil) then
begin
f := mOwner.findRecordNumByType(mEBSTypeName, mRecRef);
- if (f < 0) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]));
+ if (f < 0) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]);
if mAsMonsterId then Inc(f);
- if (f > maxv) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]));
+ if (f > maxv) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]);
end
else
begin
TType.TByte, TType.TUByte: writeInt(st, Byte(f));
TType.TShort, TType.TUShort: writeInt(st, SmallInt(f));
TType.TInt, TType.TUInt: writeInt(st, LongWord(f));
- else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
+ else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
end;
exit;
end;
TEBS.TEnum: begin end;
TEBS.TBitSet: begin end;
- else raise Exception.Create('ketmar forgot to handle some EBS type');
+ else raise TDynRecException.Create('ketmar forgot to handle some EBS type');
end;
case mType of
end;
TType.TChar:
begin
- if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
+ if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
if (mMaxDim < 0) then
begin
- if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
+ if (Length(mSVal) <> 1) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
writeInt(st, Byte(mSVal[1]));
end
else
begin
- if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
+ if (Length(mSVal) > mMaxDim) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
s := utf2win(mSVal);
if (Length(s) > 0) then st.WriteBuffer(PChar(s)^, Length(s));
for f := Length(s) to mMaxDim do writeInt(st, Byte(0));
TType.TUByte:
begin
// triggerdata array was processed earlier
- if (mMaxDim >= 0) then Exception.Create(Format('byte array in field ''%s'' cannot be written', [mName]));
+ if (mMaxDim >= 0) then TDynRecException.CreateFmt('byte array in field ''%s'' cannot be written', [mName]);
writeInt(st, Byte(mIVal));
exit;
end;
TType.TShort,
TType.TUShort:
begin
- if (mMaxDim >= 0) then raise Exception.Create(Format('short array in field ''%s'' cannot be written', [mName]));
+ if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('short array in field ''%s'' cannot be written', [mName]);
writeInt(st, Word(mIVal));
exit;
end;
TType.TInt,
TType.TUInt:
begin
- if (mMaxDim >= 0) then raise Exception.Create(Format('int array in field ''%s'' cannot be written', [mName]));
+ if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('int array in field ''%s'' cannot be written', [mName]);
writeInt(st, LongWord(mIVal));
exit;
end;
TType.TString:
begin
- raise Exception.Create(Format('cannot write string field ''%s''', [mName]));
+ raise TDynRecException.CreateFmt('cannot write string field ''%s''', [mName]);
end;
TType.TPoint:
begin
- if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
+ if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
writeInt(st, LongInt(mIVal));
writeInt(st, LongInt(mIVal2));
exit;
end;
TType.TSize:
begin
- if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
+ if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
writeInt(st, Word(mIVal));
writeInt(st, Word(mIVal2));
exit;
assert(false);
exit;
end;
- else raise Exception.Create('ketmar forgot to handle some field type');
+ else raise TDynRecException.Create('ketmar forgot to handle some field type');
end;
end;
TEBS.TEnum:
begin
//def := mOwner.mOwner;
- //es := def.findEBSType(mEBSTypeName);
+ //es := def.ebsType[mEBSTypeName];
es := nil;
if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
- if (es = nil) or (not es.mIsEnum) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
+ if (es = nil) or (not es.mIsEnum) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
for f := 0 to High(es.mVals) do
begin
if (es.mVals[f] = mIVal) then
exit;
end;
end;
- raise Exception.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]));
+ raise TDynRecException.CreateFmt('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]);
end;
TEBS.TBitSet:
begin
//def := mOwner.mOwner;
- //es := def.findEBSType(mEBSTypeName);
+ //es := def.ebsType[mEBSTypeName];
es := nil;
if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
- if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
+ if (es = nil) or es.mIsEnum then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
// none?
if (mIVal = 0) then
begin
exit;
end;
end;
- raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]));
+ raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]);
end;
// not none
mask := 1;
break;
end;
end;
- if not found then raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]));
+ if not found then raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]);
end;
mask := mask shl 1;
end;
wr.put(';'#10);
exit;
end;
- else raise Exception.Create('ketmar forgot to handle some EBS type');
+ else raise TDynRecException.Create('ketmar forgot to handle some EBS type');
end;
case mType of
end;
TType.TChar:
begin
- if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
+ if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
wr.put(quoteStr(mSVal));
wr.put(';'#10);
exit;
assert(false);
exit;
end;
- else raise Exception.Create('ketmar forgot to handle some field type');
+ else raise TDynRecException.Create('ketmar forgot to handle some field type');
end;
- raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
+ raise TDynRecException.CreateFmt('cannot parse field ''%s'' yet', [mName]);
end;
rec := mOwner;
// find trigger definition
tfld := rec.trigTypeField();
- if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mName]));
- rc := mOwner.mOwner.findTrigFor(tfld.mSVal); // find in mapdef
- 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]));
+ if (tfld = nil) then raise TDynRecException.CreateFmt('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mName]);
+ rc := mOwner.mOwner.trigTypeFor[tfld.mSVal]; // find in mapdef
+ if (rc = nil) then raise TDynRecException.CreateFmt('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal]);
rc := rc.clone(mOwner.mHeaderRec);
rc.mHeaderRec := mOwner.mHeaderRec;
- // on error, it will be freed be memowner
+ // on error, it will be freed by memowner
rc.parseBinValue(st, true);
mRecRef := rc;
mDefined := true;
TType.TUShort: f := readWord(st);
TType.TInt: f := readLongInt(st);
TType.TUInt: f := readLongWord(st);
- else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
+ else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
end;
if mAsMonsterId then Dec(f);
if (f < 0) then mRecRefId := '' else mRecRefId := Format('%s%d', [mEBSTypeName, f]);
TType.TUShort: f := readWord(st);
TType.TInt: f := readLongInt(st);
TType.TUInt: f := readLongWord(st);
- else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
+ else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
end;
es := nil;
if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
- if (es = nil) or (es.mIsEnum <> (mEBS = TEBS.TEnum)) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
+ if (es = nil) or (es.mIsEnum <> (mEBS = TEBS.TEnum)) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
mIVal := f;
// build enum/bitfield values
if (mEBS = TEBS.TEnum) then
begin
mSVal := es.nameByValue(mIVal);
- if (Length(mSVal) = 0) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]));
+ if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
end
else
begin
if (mIVal = 0) then
begin
mSVal := es.nameByValue(mIVal);
- if (Length(mSVal) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]));
+ if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
end
else
begin
if ((mIVal and mask) <> 0) then
begin
s := es.nameByValue(mask);
- if (Length(s) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]));
+ if (Length(s) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]);
if (Length(mSVal) <> 0) then mSVal += '+';
mSVal += s;
end;
mDefined := true;
exit;
end;
- else raise Exception.Create('ketmar forgot to handle some EBS type');
+ else raise TDynRecException.Create('ketmar forgot to handle some EBS type');
end;
case mType of
TType.TUInt: begin mIVal := readLongWord(st); mDefined := true; exit; end;
TType.TString:
begin
- raise Exception.Create('cannot read strings from binaries yet');
+ raise TDynRecException.Create('cannot read strings from binaries yet');
exit;
end;
TType.TPoint:
assert(false);
exit;
end;
- else raise Exception.Create('ketmar forgot to handle some field type');
+ else raise TDynRecException.Create('ketmar forgot to handle some field type');
end;
- raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
+ raise TDynRecException.CreateFmt('cannot parse field ''%s'' yet', [mName]);
end;
procedure parseInt (min, max: Integer);
begin
mIVal := pr.expectInt();
- if (mIVal < min) or (mIVal > max) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
+ if (mIVal < min) or (mIVal > max) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
mDefined := true;
end;
tk: AnsiString;
edim: AnsiChar;
begin
- if (pr.tokType = pr.TTEOF) then raise Exception.Create('field value expected');
- if (pr.tokType = pr.TTSemi) then raise Exception.Create('extra semicolon');
+ if (pr.tokType = pr.TTEOF) then raise TDynParseException.Create(pr, 'field value expected');
+ if (pr.tokType = pr.TTSemi) then raise TDynParseException.Create(pr, 'extra semicolon');
// if this field should contain struct, convert type and parse struct
case mEBS of
TEBS.TNone: begin end;
rec := mOwner;
// find trigger definition
tfld := rec.trigTypeField();
- if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName]));
- rc := mOwner.mOwner.findTrigFor(tfld.mSVal); // find in mapdef
- 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]));
+ if (tfld = nil) then raise TDynParseException.CreateFmt(pr, 'triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName]);
+ rc := mOwner.mOwner.trigTypeFor[tfld.mSVal]; // find in mapdef
+ if (rc = nil) then raise TDynParseException.CreateFmt(pr, 'triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal]);
rc := rc.clone(mOwner.mHeaderRec);
rc.mHeaderRec := mOwner.mHeaderRec;
//writeln(rc.definition);
- // on error, it will be freed be memowner
+ // on error, it will be freed by memowner
rc.parseValue(pr, true);
mRecRef := rc;
end;
rec := mOwner.findRecordByTypeId(mEBSTypeName, pr.tokStr);
if (rec = nil) then
begin
- //raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSTypeName, mName]));
mRecRefId := pr.tokStr;
end
else
end
else if (pr.tokType = pr.TTBegin) then
begin
- //rec := mOwner.mOwner.findRecType(mEBSTypeName); // find in mapdef
+ //rec := mOwner.mOwner.recType[mEBSTypeName]; // find in mapdef
rec := nil;
if (mEBSType <> nil) and (mEBSType is TDynRecord) then rec := (mEBSType as TDynRecord);
- if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
+ if (rec = nil) then raise TDynParseException.CreateFmt(pr, 'record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
rc := rec.clone(mOwner.mHeaderRec);
rc.mHeaderRec := mOwner.mHeaderRec;
rc.parseValue(pr);
mDefined := true;
if mOwner.addRecordByType(mEBSTypeName, rc) then
begin
- //raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
- e_LogWritefln('duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mName]);
+ raise TDynParseException.CreateFmt(pr, 'duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mName]);
end;
pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records
exit;
end;
TEBS.TEnum:
begin
- //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef
+ //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
es := nil;
if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
- if (es = nil) or (not es.mIsEnum) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
+ if (es = nil) or (not es.mIsEnum) then raise TDynParseException.CreateFmt(pr, 'record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
tk := pr.expectId();
- 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]));
+ 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]);
mIVal := es.field[tk];
mSVal := tk;
//writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
end;
TEBS.TBitSet:
begin
- //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef
+ //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
es := nil;
if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
- if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
+ if (es = nil) or es.mIsEnum then raise TDynParseException.CreateFmt(pr, 'record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
mIVal := 0;
while true do
begin
tk := pr.expectId();
- 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]));
+ 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]);
mIVal := mIVal or es.field[tk];
mSVal := tk;
if (pr.tokType <> pr.TTDelim) or ((pr.tokChar <> '|') and (pr.tokChar <> '+')) then break;
- if mBitSetUnique then raise Exception.Create(Format('record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]));
- //pr.expectDelim('|');
+ if mBitSetUnique then raise TDynParseException.CreateFmt(pr, 'record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]);
pr.skipToken(); // plus or pipe
end;
mDefined := true;
pr.expectTT(pr.TTSemi);
exit;
end;
- else raise Exception.Create('ketmar forgot to handle some EBS type');
+ else raise TDynParseException.Create(pr, 'ketmar forgot to handle some EBS type');
end;
case mType of
begin
if pr.eatId('true') or pr.eatId('tan') or pr.eatId('yes') then mIVal := 1
else if pr.eatId('false') or pr.eatId('ona') or pr.eatId('no') then mIVal := 0
- else raise Exception.Create(Format('invalid bool value for field ''%s''', [mName]));
+ else raise TDynParseException.CreateFmt(pr, 'invalid bool value for field ''%s''', [mName]);
mDefined := true;
pr.expectTT(pr.TTSemi);
exit;
end;
TType.TChar:
begin
- if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
+ if (mMaxDim = 0) then raise TDynParseException.CreateFmt(pr, 'invalid string size definition for field ''%s''', [mName]);
mSVal := pr.expectStr(true);
if (mMaxDim < 0) then
begin
// single char
- if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
+ if (Length(mSVal) <> 1) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
mIVal := Integer(mSVal[1]);
mSVal := '';
end
else
begin
// string
- if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
+ if (Length(mSVal) > mMaxDim) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
end;
mDefined := true;
pr.expectTT(pr.TTSemi);
mIVal := pr.expectInt();
if (mType = TType.TSize) then
begin
- if (mIVal < 0) or (mIVal > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
+ if (mIVal < 0) or (mIVal > 32767) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
end;
mIVal2 := pr.expectInt();
if (mType = TType.TSize) then
begin
- if (mIVal2 < 0) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
+ if (mIVal2 < 0) or (mIVal2 > 32767) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
end;
mDefined := true;
pr.expectDelim(edim);
assert(false);
exit;
end;
- else raise Exception.Create('ketmar forgot to handle some field type');
+ else raise TDynParseException.Create(pr, 'ketmar forgot to handle some field type');
end;
- raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
+ raise TDynParseException.CreateFmt(pr, 'cannot parse field ''%s'' yet', [mName]);
end;
// ////////////////////////////////////////////////////////////////////////// //
constructor TDynRecord.Create (pr: TTextParser);
begin
- if (pr = nil) then raise Exception.Create('cannot create record type without type definition');
+ if (pr = nil) then raise TDynParseException.Create(pr, 'cannot create record type without type definition');
mId := '';
mName := '';
mSize := 0;
procedure TDynRecord.addField (fld: TDynField); inline;
begin
- if (fld = nil) then raise Exception.Create('cannot append nil field to record');
+ if (fld = nil) then raise TDynRecException.Create('cannot append nil field to record');
mFields.append(fld);
{$IF DEFINED(XDYNREC_USE_FIELDHASH)}
if (Length(fld.mName) > 0) then mFieldsHash.put(fld.mName, mFields.count-1);
function TDynRecord.addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
begin
result := false;
- if (fld = nil) then raise Exception.Create('cannot append nil field to record');
+ if (fld = nil) then raise TDynRecException.Create('cannot append nil field to record');
{$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
if (Length(fld.mName) > 0) then result := hasByName(fld.mName);
{$ENDIF}
// find record data
fld := mHeaderRec.field[atypename];
if (fld = nil) then exit;
- 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]));
+ if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
// find by id
if (fld.mRVal <> nil) then
begin
// find record data
fld := mHeaderRec.field[atypename];
if (fld = nil) then exit;
- 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]));
+ if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
// find by ref
if (fld.mRVal <> nil) then
begin
fld.mOwner := mHeaderRec;
mHeaderRec.addField(fld);
end;
- 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]));
+ if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename]);
// append
if (fld.mRVal = nil) then
begin
// number of records of the given instance
-function TDynRecord.instanceCount (const typename: AnsiString): Integer;
+function TDynRecord.instanceCount (const atypename: AnsiString): Integer;
var
fld: TDynField;
begin
result := 0;
- fld := field[typename];
+ fld := field[atypename];
if (fld <> nil) and (fld.mType = fld.TType.TList) then result := fld.mRVal.count;
end;
+function TDynRecord.newTypedRecord (const atypename, aid: AnsiString): TDynRecord;
+var
+ trc: TDynRecord;
+begin
+ if not mHeader then raise TDynRecException.Create('cannot create new records with non-header');
+ trc := mapdef.recType[atypename];
+ if (trc = nil) then begin result := nil; exit; end;
+ result := trc.clone(self);
+ result.mId := ''; // for now
+ addRecordByType(atypename, result);
+ result.mId := aid;
+end;
+
+
function TDynRecord.getUserVar (const aname: AnsiString): Variant;
var
fld: TDynField;
begin
fld := getFieldByName(aname);
- if (fld = nil) then result := Unassigned else result := fld.varvalue;
+ if (fld = nil) then result := Unassigned else result := fld.value;
end;
fld := getFieldByName(aname);
if (fld = nil) then
begin
- if (Length(aname) = 0) then raise Exception.Create('cannot create nameless user field');
+ if (Length(aname) = 0) then raise TDynRecException.Create('cannot create nameless user field');
fld := TDynField.Create(aname, val);
fld.mOwner := self;
fld.mInternal := true;
end
else
begin
- fld.varvalue := val;
+ fld.value := val;
end;
end;
while pr.eatTT(pr.TTComma) do begin end;
if pr.eatDelim(')') then break;
tdn := pr.expectId();
- if isForTrig[tdn] then raise Exception.Create(Format('duplicate trigdata ''%s'' trigtype ''%s''', [mName, tdn]));
+ if isForTrig[tdn] then raise TDynParseException.CreateFmt(pr, 'duplicate trigdata ''%s'' trigtype ''%s''', [mName, tdn]);
SetLength(mTrigTypes, Length(mTrigTypes)+1);
mTrigTypes[High(mTrigTypes)] := tdn;
end;
if pr.eatId('header') then begin mHeader := true; continue; end;
if pr.eatId('size') then
begin
- if (mSize > 0) then raise Exception.Create(Format('duplicate `size` in record ''%s''', [mName]));
+ if (mSize > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `size` in record ''%s''', [mName]);
mSize := pr.expectInt();
- if (mSize < 1) then raise Exception.Create(Format('invalid record ''%s'' size: %d', [mName, mSize]));
+ if (mSize < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' size: %d', [mName, mSize]);
pr.expectId('bytes');
continue;
end;
if pr.eatId('binblock') then
begin
- if (mBinBlock >= 0) then raise Exception.Create(Format('duplicate `binblock` in record ''%s''', [mName]));
+ if (mBinBlock >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `binblock` in record ''%s''', [mName]);
mBinBlock := pr.expectInt();
- if (mBinBlock < 1) then raise Exception.Create(Format('invalid record ''%s'' binblock: %d', [mName, mBinBlock]));
+ if (mBinBlock < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' binblock: %d', [mName, mBinBlock]);
continue;
end;
end;
while (pr.tokType <> pr.TTEnd) do
begin
fld := TDynField.Create(pr);
- //if hasByName(fld.name) then begin fld.Free(); raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); end;
// append
fld.mOwner := self;
if addFieldChecked(fld) then
begin
fld.Free();
- raise Exception.Create(Format('duplicate field ''%s''', [fld.name]));
+ raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s''', [fld.name]);
end;
// done with field
end;
if (rt = nil) then
begin
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);
- //raise Exception.Create(Format('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]));
+ //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]);
end;
//writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
fld.mRecRefId := '';
// parse map file as sequence of blocks
sign[0] := #4;
st.ReadBuffer(sign[1], 4);
- if (sign <> 'MAP'#1) then raise Exception.Create('invalid binary map signature');
+ if (sign <> 'MAP'#1) then raise TDynRecException.Create('invalid binary map signature');
// parse blocks
while (st.position < st.size) do
begin
readLongWord(st); // reserved
bsize := readLongInt(st);
{$IF DEFINED(D2D_XDYN_DEBUG)}writeln('btype=', btype, '; bsize=', bsize);{$ENDIF}
- if (bsize < 0) or (bsize > $1fffffff) then raise Exception.Create(Format('block of type %d has invalid size %d', [btype, bsize]));
- if loaded[btype] then raise Exception.Create(Format('block of type %d already loaded', [btype]));
+ if (bsize < 0) or (bsize > $1fffffff) then raise TDynRecException.CreateFmt('block of type %d has invalid size %d', [btype, bsize]);
+ if loaded[btype] then raise TDynRecException.CreateFmt('block of type %d already loaded', [btype]);
loaded[btype] := true;
// find record type for this block
rect := nil;
for rec in mOwner.recTypes do if (rec.mBinBlock = btype) then begin rect := rec; break; end;
- if (rect = nil) then raise Exception.Create(Format('block of type %d has no corresponding record', [btype]));
+ if (rect = nil) then raise TDynRecException.CreateFmt('block of type %d has no corresponding record', [btype]);
//writeln('found type ''', rec.mName, ''' for block type ', btype);
- if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise Exception.Create(Format('block of type %d has invalid number of records', [btype]));
+ if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise TDynRecException.CreateFmt('block of type %d has invalid number of records', [btype]);
// header?
if (rect.mHeader) then
begin
- if (bsize <> mSize) then raise Exception.Create(Format('header block of type %d has invalid number of records', [btype]));
+ if (bsize <> mSize) then raise TDynRecException.CreateFmt('header block of type %d has invalid number of records', [btype]);
GetMem(buf, bsize);
st.ReadBuffer(buf^, bsize);
mst.setup(buf, mSize);
// read fields
if StrEqu(mName, 'TriggerData') then mSize := Integer(st.size-st.position);
- if (mSize < 1) then raise Exception.Create(Format('cannot read record of type ''%s'' with unknown size', [mName]));
+ if (mSize < 1) then raise TDynRecException.CreateFmt('cannot read record of type ''%s'' with unknown size', [mName]);
GetMem(buf, mSize);
st.ReadBuffer(buf^, mSize);
for fld in mFields do
begin
if fld.mInternal then continue;
if (fld.mBinOfs < 0) then continue;
- if (fld.mBinOfs >= st.size) then raise Exception.Create(Format('record of type ''%s'' has invalid field ''%s''', [fld.mName]));
+ if (fld.mBinOfs >= st.size) then raise TDynRecException.CreateFmt('record of type ''%s'' has invalid field ''%s''', [fld.mName]);
mst.setup(buf+fld.mBinOfs, mSize-fld.mBinOfs);
//writeln('parsing ''', mName, '.', fld.mName, '''...');
fld.parseBinValue(mst);
begin
if (trigbufsz < 0) then
begin
- if (mBinBlock < 1) then raise Exception.Create('cannot write binary record without block number');
- if (mSize < 1) then raise Exception.Create('cannot write binary record without size');
+ if (mBinBlock < 1) then raise TDynRecException.Create('cannot write binary record without block number');
+ if (mSize < 1) then raise TDynRecException.Create('cannot write binary record without size');
bufsz := mSize;
end
else
if (fld.mType = fld.TType.TList) then continue; // later
if fld.mInternal then continue;
if (fld.mBinOfs < 0) then continue;
- if (fld.mBinOfs >= bufsz) then raise Exception.Create('binary value offset is outside of the buffer');
+ if (fld.mBinOfs >= bufsz) then raise TDynRecException.Create('binary value offset is outside of the buffer');
TSFSMemoryChunkStream(ws).setup(buf+fld.mBinOfs, bufsz-fld.mBinOfs);
//writeln('writing field <', fld.mName, '>');
fld.writeBinTo(ws);
if (fld.mType = fld.TType.TList) then
begin
if (fld.mRVal = nil) or (fld.mRVal.count = 0) then continue;
- rec := mOwner.findRecType(fld.mName);
+ rec := mOwner.recType[fld.mName];
if (rec = nil) then continue;
if (rec.mBinBlock <= 0) then continue;
if (blkmax < rec.mBinBlock) then blkmax := rec.mBinBlock;
if (fld.mType = fld.TType.TList) then
begin
if (fld.mRVal = nil) or (fld.mRVal.count = 0) then continue;
- rec := mOwner.findRecType(fld.mName);
+ rec := mOwner.recType[fld.mName];
if (rec = nil) then continue;
if (rec.mBinBlock <> blk) then continue;
if (ws = nil) then ws := TMemoryStream.Create();
// record list?
if (fld.mType = fld.TType.TList) then
begin
- if not mHeader then raise Exception.Create('record list in non-header record');
+ if not mHeader then raise TDynRecException.Create('record list in non-header record');
if (fld.mRVal <> nil) then
begin
for rec in fld.mRVal do
rt := findRecordByTypeId(fld.mEBSTypeName, fld.mRecRefId);
if (rt = nil) then
begin
- 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);
- //raise Exception.Create(Format('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]));
+ //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);
+ raise TDynParseException.CreateFmt(pr, '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]);
end;
//writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
fld.mRecRefId := '';
end;
begin
- if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName]));
+ if (mOwner = nil) then raise TDynParseException.CreateFmt(pr, 'can''t parse record ''%s'' value without owner', [mName]);
{$IF DEFINED(D2D_DYNREC_PROFILER)}stall := curTimeMicro();{$ENDIF}
if not beginEaten then pr.expectTT(pr.TTBegin);
while (pr.tokType <> pr.TTEnd) do
begin
- if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
+ if (pr.tokType <> pr.TTId) then raise TDynParseException.Create(pr, 'identifier expected');
//writeln('<', mName, '.', pr.tokStr, '>');
// records
begin
// add records with this type (if any)
{$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
- trc := mOwner.findRecType(pr.tokStr);
+ trc := mOwner.recType[pr.tokStr];
{$IF DEFINED(D2D_DYNREC_PROFILER)}profFindRecType := curTimeMicro()-stt;{$ENDIF}
if (trc <> nil) then
begin
rec := trc.clone(mHeaderRec);
{$IF DEFINED(D2D_DYNREC_PROFILER)}profCloneRec := curTimeMicro()-stt;{$ENDIF}
rec.mHeaderRec := mHeaderRec;
- // on error, it will be freed be memowner
+ // on error, it will be freed by memowner
pr.skipToken();
rec.parseValue(pr);
- (*
- if (Length(rec.mId) > 0) then
- begin
- {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
- fld := field[pr.tokStr];
- {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF}
- (*
- if (fld <> nil) and (fld.mRVal <> nil) then
- begin
- {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
- //idtmp := trc.mName+':'+rec.mId;
- //if ids.put(idtmp, 1) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
- if fld.mRHash.has(rec.mId) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
- {$IF DEFINED(D2D_DYNREC_PROFILER)}profListDupChecking := curTimeMicro()-stt;{$ENDIF}
- end;
- end;
- *)
{$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
addRecordByType(rec.mName, rec);
{$IF DEFINED(D2D_DYNREC_PROFILER)}profAddRecByType := curTimeMicro()-stt;{$ENDIF}
if (fld <> nil) then
begin
//writeln('2: <', mName, '.', pr.tokStr, '>');
- if fld.defined then raise Exception.Create(Format('duplicate field ''%s'' in record ''%s''', [fld.mName, mName]));
- if fld.internal then raise Exception.Create(Format('internal field ''%s'' in record ''%s''', [fld.mName, mName]));
+ if fld.defined then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in record ''%s''', [fld.mName, mName]);
+ if fld.internal then raise TDynParseException.CreateFmt(pr, 'internal field ''%s'' in record ''%s''', [fld.mName, mName]);
pr.skipToken(); // skip field name
//writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType);
{$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
end;
// something is wrong
- raise Exception.Create(Format('unknown field ''%s'' in record ''%s''', [pr.tokStr, mName]));
+ raise TDynParseException.CreateFmt(pr, 'unknown field ''%s'' in record ''%s''', [pr.tokStr, mName]);
end;
pr.expectTT(pr.TTEnd);
idname := pr.expectId();
for f := 0 to High(mIds) do
begin
- if StrEqu(mIds[f], idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
+ if StrEqu(mIds[f], idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]);
end;
- if StrEqu(mMaxName, idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
+ if StrEqu(mMaxName, idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]);
skipAdd := false;
hasV := false;
v := cv;
begin
if pr.eatId('MAX') then
begin
- if (Length(mMaxName) > 0) then raise Exception.Create(Format('duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mName]));
+ if (Length(mMaxName) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mName]);
mMaxName := idname;
skipAdd := true;
end
function TDynMapDef.getHeaderRecType (): TDynRecord; inline;
begin
- if (recTypes.count = 0) then raise Exception.Create('no header in empty mapdef');
+ if (recTypes.count = 0) then raise TDynRecException.Create('no header in empty mapdef');
result := recTypes[0];
end;
begin
for rec in recTypes do
begin
- if StrEqu(rec.name, aname) then begin result := rec; exit; end;
+ if StrEqu(rec.typeName, aname) then begin result := rec; exit; end;
end;
result := nil;
end;
begin
for ebs in ebsTypes do
begin
- if StrEqu(ebs.name, aname) then begin result := ebs; exit; end;
+ if StrEqu(ebs.typeName, aname) then begin result := ebs; exit; end;
end;
result := nil;
end;
TDynField.TEBS.TRec:
begin
fld.mEBSType := findRecType(fld.mEBSTypeName);
- if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]));
+ if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]);
end;
TDynField.TEBS.TEnum,
TDynField.TEBS.TBitSet:
begin
fld.mEBSType := findEBSType(fld.mEBSTypeName);
- if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]));
- if ((fld.mEBS = TDynField.TEBS.TEnum) <> (fld.mEBSType as TDynEBS).mIsEnum) then raise Exception.Create(Format('field ''%s'' of type ''%s'' enum/bitset type conflict', [fld.mName, fld.mEBSTypeName]));
+ if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]);
+ 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]);
end;
end;
end;
if (pr.tokStr = 'enum') or (pr.tokStr = 'bitset') then
begin
eb := TDynEBS.Create(pr);
- if (findEBSType(eb.name) <> nil) then
+ if (findEBSType(eb.typeName) <> nil) then
begin
eb.Free();
- raise Exception.Create(Format('duplicate enum/bitset ''%s''', [eb.name]));
+ raise TDynParseException.CreateFmt(pr, 'duplicate enum/bitset ''%s''', [eb.typeName]);
end;
eb.mOwner := self;
ebsTypes.append(eb);
if (findTrigFor(rec.mTrigTypes[f]) <> nil) then
begin
rec.Free();
- raise Exception.Create(Format('duplicate trigdata ''%s''', [rec.mTrigTypes[f]]));
+ raise TDynParseException.CreateFmt(pr, 'duplicate trigdata ''%s''', [rec.mTrigTypes[f]]);
end;
end;
rec.mOwner := self;
rec := TDynRecord.Create(pr);
//writeln(dr.definition); writeln;
- if (findRecType(rec.name) <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
- if (hdr <> nil) and StrEqu(rec.name, hdr.name) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
+ if (findRecType(rec.typeName) <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
+ if (hdr <> nil) and StrEqu(rec.typeName, hdr.typeName) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
rec.mOwner := self;
if rec.mHeader then
begin
- if (hdr <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate header record ''%s'' (previous is ''%s'')', [rec.name, hdr.name])); end;
+ if (hdr <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate header record ''%s'' (previous is ''%s'')', [rec.typeName, hdr.typeName]); end;
hdr := rec;
end
else
end;
// put header record to top
- if (hdr = nil) then raise Exception.Create('header definition not found in mapdef');
+ if (hdr = nil) then raise TDynParseException.Create(pr, 'header definition not found in mapdef');
recTypes.append(nil);
for f := recTypes.count-1 downto 1 do recTypes[f] := recTypes[f-1];
recTypes[0] := hdr;
// ////////////////////////////////////////////////////////////////////////// //
-function TDynMapDef.parseMap (pr: TTextParser): TDynRecord;
+function TDynMapDef.parseTextMap (pr: TTextParser): TDynRecord;
var
res: TDynRecord = nil;
begin
result := nil;
try
- pr.expectId(headerType.name);
+ pr.expectId(headerType.typeName);
res := headerType.clone(nil);
res.mHeaderRec := res;
res.parseValue(pr);
end;
+// WARNING! stream must be seekable
+function TDynMapDef.parseMap (st: TStream): TDynRecord;
+var
+ sign: packed array[0..3] of AnsiChar;
+ pr: TTextParser;
+begin
+ st.position := 0;
+ st.ReadBuffer(sign[0], 4);
+ st.position := 0;
+ if (sign[0] = 'M') and (sign[1] = 'A') and (sign[2] = 'P') then
+ begin
+ if (sign[3] = #1) then
+ begin
+ result := parseBinMap(st);
+ exit;
+ end;
+ raise TDynRecException.Create('invalid binary map version');
+ end
+ else
+ begin
+ pr := TFileTextParser.Create(st, false); // `st` is not owned
+ try
+ try
+ result := parseTextMap(pr);
+ except on e: Exception do
+ raise TDynParseException.Create(pr, e.message);
+ end;
+ finally
+ pr.Free();
+ end;
+ end;
+end;
+
+
+// returns `true` if the given stream can be a map file
+// stream position is 0 on return
+// WARNING! stream must be seekable
+class function TDynMapDef.canBeMap (st: TStream): Boolean;
+var
+ sign: packed array[0..3] of AnsiChar;
+ pr: TTextParser;
+begin
+ result := false;
+ st.position := 0;
+ st.ReadBuffer(sign[0], 4);
+ if (sign[0] = 'M') and (sign[1] = 'A') and (sign[2] = 'P') then
+ begin
+ result := (sign[3] = #1);
+ end
+ else
+ begin
+ st.position := 0;
+ pr := TFileTextParser.Create(st, false); // `st` is not owned
+ result := (pr.tokType = pr.TTId) and (pr.tokStr = 'map');
+ pr.Free();
+ end;
+ st.position := 0;
+end;
+
+
function TDynMapDef.pasdefconst (): AnsiString;
var
ebs: TDynEBS;
end;
+function TDynMapDef.getRecTypeCount (): Integer; inline; begin result := recTypes.count; end;
+function TDynMapDef.getRecTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < recTypes.count) then result := recTypes[idx] else result := nil; end;
+
+function TDynMapDef.getEBSTypeCount (): Integer; inline; begin result := ebsTypes.count; end;
+function TDynMapDef.getEBSTypeAt (idx: Integer): TDynEBS; inline; begin if (idx >= 0) and (idx < ebsTypes.count) then result := ebsTypes[idx] else result := nil; end;
+
function TDynMapDef.getTrigTypeCount (): Integer; inline; begin result := trigTypes.count; end;
function TDynMapDef.getTrigTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < trigTypes.count) then result := trigTypes[idx] else result := nil; end;
diff --git a/src/tools/mapgen.dpr b/src/tools/mapgen.dpr
index 27c718306e114e612f526d1aa0831983a32952bb..dd1cfa7c2b2517b7c7bf7eca6c2c4b361fc423ea 100644 (file)
--- a/src/tools/mapgen.dpr
+++ b/src/tools/mapgen.dpr
@@ -101,7 +101,7 @@ function TDynRecordHelper.trigTlpDir (): Byte; inline; begin result := Byte(getF
write(foimpl, #10'// ');
write(fohlp, #10'// ');
needComma := false;
- trec := dfmapdef.trigType[tidx];
+ trec := dfmapdef.trigTypeAt[tidx];
for nidx := 0 to trec.forTrigCount-1 do
begin
if needComma then write(fohlp, ', ');
@@ -129,8 +129,8 @@ function TDynRecordHelper.trigTlpDir (): Byte; inline; begin result := Byte(getF
knownfld := nil;
if fldknown.get(toLowerCase1251(palias), knownfld) then
begin
- if (fld.name <> knownfld.name) then raise Exception.Create(formatstrf('field ''%s'' of record ''%s'' conflicts with other field ''%s''', [fld.name, trec.name, knownfld.name]));
- if (fld.baseType <> knownfld.baseType) then raise Exception.Create(formatstrf('field ''%s'' of record ''%s'' conflicts with other field ''%s'' by type', [fld.name, trec.name, knownfld.name]));
+ if (fld.name <> knownfld.name) then raise Exception.Create(formatstrf('field ''%s'' of record ''%s'' conflicts with other field ''%s''', [fld.name, trec.typeName, knownfld.name]));
+ if (fld.baseType <> knownfld.baseType) then raise Exception.Create(formatstrf('field ''%s'' of record ''%s'' conflicts with other field ''%s'' by type', [fld.name, trec.typeName, knownfld.name]));
writeln('skipped duplicate field ''', fld.name, '''');
continue;
end;