summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: d7d166d)
raw | patch | inline | side by side (parent: d7d166d)
author | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
Sun, 17 Sep 2017 03:15:50 +0000 (06:15 +0300) | ||
committer | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
Sun, 17 Sep 2017 03:16:05 +0000 (06:16 +0300) |
src/game/g_map.pas | patch | blob | history | |
src/shared/exoma.pas | patch | blob | history | |
src/shared/xdynrec.pas | patch | blob | history | |
src/shared/xparser.pas | patch | blob | history |
diff --git a/src/game/g_map.pas b/src/game/g_map.pas
index bd949579204bebf3560f558c2d840ef49abd9a44..cf60d78b958b52376470cb7450ee71bd66b16283 100644 (file)
--- a/src/game/g_map.pas
+++ b/src/game/g_map.pas
FLAG_SIGNATURE = $47414C46; // 'FLAG'
+// ////////////////////////////////////////////////////////////////////////// //
+procedure mapWarningCB (const msg: AnsiString; line, col: Integer);
+begin
+ if (line > 0) then
+ begin
+ e_LogWritefln('parse error at (%s,%s): %s', [line, col, msg], TMsgType.Warning);
+ end
+ else
+ begin
+ e_LogWritefln('parse error: %s', [msg], TMsgType.Warning);
+ end;
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
var
panByGUID: array of TPanel = nil;
end;
+begin
+ DynWarningCB := mapWarningCB;
end.
diff --git a/src/shared/exoma.pas b/src/shared/exoma.pas
index ec9bbf8b40d0d83f62e97ef3577ce54bf40ba535..1931dbbee9c973bbbf4840714fbe4fdcda91f8fe 100644 (file)
--- a/src/shared/exoma.pas
+++ b/src/shared/exoma.pas
try
while true do
begin
- while pr.eatTT(pr.TTSemi) do begin end;
+ while pr.eatDelim(';') do begin end;
if (pr.tokType = pr.TTEOF) then break;
e := parse(clist, pr, true);
if (e = nil) then break;
if (pr.tokType = pr.TTEOF) then break;
//writeln('tt=', pr.tokType, ' <', pr.tokStr, '>');
//writeln(r.toString());
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
end;
result := r;
r := nil;
@@ -1130,7 +1130,7 @@ class function TExprBase.parse (clist: TExprConstList; pr: TTextParser; allowAss
e := doLogOr();
if neg then e := TUnExprNeg.Create(e);
if allowAssign and pr.eatDelim('=') then e := TBinAssign.Create(e, expr());
- if not pr.eatTT(pr.TTComma) then
+ if not pr.eatDelim(',') then
begin
if (result = nil) then result := e else list.append(e);
break;
@@ -1162,7 +1162,7 @@ class function TExprBase.parse (clist: TExprConstList; pr: TTextParser; allowAss
c.mCond := result;
try
c.mTrue := expr();
- pr.expectTT(pr.TTColon);
+ pr.expectDelim(':');
c.mFalse := expr();
result := c;
except
@@ -1172,16 +1172,16 @@ class function TExprBase.parse (clist: TExprConstList; pr: TTextParser; allowAss
end;
var
- oas: Boolean;
+ oas: TTextParser.TOptions;
begin
if (pr = nil) or (pr.tokType = pr.TTEOF) then begin result := nil; exit; end;
- oas := pr.allowSignedNumbers;
+ oas := pr.options;
try
- pr.allowSignedNumbers := false;
+ pr.options := pr.options-[pr.TOption.SignedNumbers];
try
result := expr();
finally
- pr.allowSignedNumbers := oas;
+ pr.options := oas;
end;
except
on e: TExomaException do
diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas
index 8b6534ccd2ae0217091932b710e9d6a53d77877f..a9d3bbe45c86f9d7fd7195207cf079e4fdef88d5 100644 (file)
--- a/src/shared/xdynrec.pas
+++ b/src/shared/xdynrec.pas
procedure xdynDumpProfiles ();
{$ENDIF}
+var
+ DynWarningCB: procedure (const msg: AnsiString; line, col: Integer) = nil;
implementation
+{$IF DEFINED(D2D_DYNREC_PROFILER)}
uses
- e_log
- {$IF DEFINED(D2D_DYNREC_PROFILER)},xprofiler{$ENDIF};
+ xprofiler;
+{$ENDIF}
// ////////////////////////////////////////////////////////////////////////// //
// field name
fldname := pr.expectStrOrId();
- while (pr.tokType <> pr.TTSemi) do
+ while (not pr.isDelim(';')) do
begin
if pr.eatId('type') then
begin
lebs := TDynField.TEBS.TRec;
end;
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
// create field
mName := fldname;
edim: AnsiChar;
begin
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 (pr.isDelim(';')) 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;
// ugly hack. sorry.
if (mType = TType.TTrigData) then
begin
- pr.expectTT(pr.TTBegin);
- if (pr.tokType = pr.TTEnd) then
+ pr.expectDelim('{');
+ if (pr.eatDelim('}')) then
begin
// '{}'
mRecRef := nil;
- pr.expectTT(pr.TTEnd);
end
else
begin
mRecRef := rc;
end;
mDefined := true;
- pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records
+ pr.eatDelim(';'); // hack: allow (but don't require) semicolon after inline records
exit;
end;
// other record types
pr.expectId();
end;
mDefined := true;
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
exit;
end
- else if (pr.tokType = pr.TTBegin) then
+ else if (pr.isDelim('{')) then
begin
//rec := mOwner.mOwner.recType[mEBSTypeName]; // find in mapdef
rec := nil;
begin
raise TDynParseException.CreateFmt(pr, 'duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mTypeName]);
end;
- pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records
+ pr.eatDelim(';'); // hack: allow (but don't require) semicolon after inline records
exit;
end;
- pr.expectTT(pr.TTBegin);
+ pr.expectDelim('{');
end;
TEBS.TEnum:
begin
mSVal := tk;
//writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
mDefined := true;
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
exit;
end;
TEBS.TBitSet:
pr.skipToken(); // plus or pipe
end;
mDefined := true;
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
exit;
end;
else raise TDynParseException.Create(pr, 'ketmar forgot to handle some EBS type');
else if pr.eatId('false') or pr.eatId('ona') or pr.eatId('no') then mIVal := 0
else raise TDynParseException.CreateFmt(pr, 'invalid bool value for field ''%s''', [mName]);
mDefined := true;
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
exit;
end;
TType.TChar:
if (Length(mSVal) > mMaxDim) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
end;
mDefined := true;
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
exit;
end;
TType.TByte:
begin
parseInt(-128, 127);
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
exit;
end;
TType.TUByte:
begin
parseInt(0, 255);
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
exit;
end;
TType.TShort:
begin
parseInt(-32768, 32768);
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
exit;
end;
TType.TUShort:
begin
parseInt(0, 65535);
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
exit;
end;
TType.TInt:
begin
parseInt(Integer($80000000), $7fffffff);
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
exit;
end;
TType.TUInt:
begin
parseInt(0, $7fffffff); //FIXME
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
exit;
end;
TType.TString:
begin
mSVal := pr.expectStr(true);
mDefined := true;
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
exit;
end;
TType.TPoint,
end;
mDefined := true;
pr.expectDelim(edim);
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
exit;
end;
TType.TColor:
end;
mDefined := true;
pr.expectDelim(edim);
- pr.expectTT(pr.TTSemi);
+ pr.expectDelim(';');
exit;
end;
TType.TList:
begin
while true do
begin
- while pr.eatTT(pr.TTComma) do begin end;
+ while (pr.eatDelim(',')) do begin end;
if pr.eatDelim(')') then break;
tdn := pr.expectId();
if isForTrig[tdn] then raise TDynParseException.CreateFmt(pr, 'duplicate trigdata ''%s'' trigtype ''%s''', [mTypeName, tdn]);
else
begin
mTypeName := pr.expectStrOrId();
- while (pr.tokType <> pr.TTBegin) do
+ while (not pr.isDelim('{')) do
begin
if pr.eatId('header') then begin mHeader := true; continue; end;
if pr.eatId('size') then
end;
end;
- pr.expectTT(pr.TTBegin);
+ pr.expectDelim('{');
// load fields
- while (pr.tokType <> pr.TTEnd) do
+ while (not pr.isDelim('}')) do
begin
fld := TDynField.Create(pr);
// append
end;
// done with field
end;
- pr.expectTT(pr.TTEnd);
+ pr.expectDelim('}');
end;
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.mTypeName, rec.mId, fld.mEBSTypeName, fld.mRecRefId], TMsgType.Warning);
+ if assigned(DynWarningCB) then
+ begin
+ DynWarningCB(formatstrf('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mTypeName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]), -1, -1);
+ end;
//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, ')');
end;
//writeln('parsing record <', mName, '>');
- if not beginEaten then pr.expectTT(pr.TTBegin);
- while (pr.tokType <> pr.TTEnd) do
+ if not beginEaten then pr.expectDelim('{');
+ while (not pr.isDelim('}')) do
begin
if (pr.tokType <> pr.TTId) then raise TDynParseException.Create(pr, 'identifier expected');
//writeln('<', mName, '.', pr.tokStr, '>');
// something is wrong
raise TDynParseException.CreateFmt(pr, 'unknown field ''%s'' in record ''%s''', [pr.tokStr, mTypeName]);
end;
- pr.expectTT(pr.TTEnd);
+ pr.expectDelim('}');
if mHeader then
begin
mTypeName := pr.expectId();
mMaxVal := Integer($80000000);
if mIsEnum then cv := 0 else cv := 1;
- while (pr.tokType <> pr.TTBegin) do
+ while (not pr.isDelim('{')) do
begin
if pr.eatId('tip') then
begin
end;
break;
end;
- pr.expectTT(pr.TTBegin);
- while (pr.tokType <> pr.TTEnd) do
+ pr.expectDelim('{');
+ while (not pr.isDelim('}')) do
begin
idname := pr.expectId();
for f := 0 to High(mIds) do
if mIsEnum then Inc(cv) else cv := cv shl 1;
end;
end;
- if (pr.tokType = pr.TTEnd) then break;
- pr.expectTT(pr.TTComma);
- while pr.eatTT(pr.TTComma) do begin end;
+ if (pr.isDelim('}')) then break;
+ pr.expectDelim(',');
+ while (pr.eatDelim(',')) do begin end;
end;
- pr.expectTT(pr.TTEnd);
+ pr.expectDelim('}');
// add max field
if (Length(mMaxName) > 0) then
begin
diff --git a/src/shared/xparser.pas b/src/shared/xparser.pas
index eb56686ee1daa9c4c9aa83184e4cb8c5226fefad..b704c4b7016a65f119192cc325e07fe49e51bf85 100644 (file)
--- a/src/shared/xparser.pas
+++ b/src/shared/xparser.pas
TTInt = 2;
//TTFloat = 3; // not yet
TTStr = 4; // string
- TTComma = 5; // ','
- TTColon = 6; // ':'
- TTSemi = 7; // ';'
- TTBegin = 8; // left curly
- TTEnd = 9; // right curly
- TTDelim = 10; // other delimiters
+ TTDelim = 5; // one-char delimiters
//
TTLogAnd = 11; // &&
TTLogOr = 12; // ||
TTLessEqu = 13; // <=
TTGreatEqu = 14; // >=
TTNotEqu = 15; // !=
- TTEqu = 16; // ==
+ TTEqu = 16; // == or <>
+ TTAss = 17; // :=
+ TTShl = 18; // <<
+ TTShr = 19; // >>
+ TTDotDot = 19; // ..
+
+ public
+ type
+ TOption = (
+ SignedNumbers, // allow signed numbers; otherwise sign will be TTDelim
+ DollarIsId, // allow dollar in identifiers; otherwise dollar will be TTDelim
+ DotIsId // allow dot in identifiers; otherwise dot will be TTDelim
+ );
+ TOptions = set of TOption;
+
+ private
+ type
+ TAnsiCharSet = set of AnsiChar;
private
mLine, mCol: Integer;
mCurChar, mNextChar: AnsiChar;
- mAllowSignedNumbers: Boolean; // internal control
+ mOptions: TOptions;
mTokLine, mTokCol: Integer; // token start
mTokType: Integer;
mTokInt: Integer;
protected
- procedure warmup (); virtual; // called in constructor to warm up the system
+ procedure warmup (); // called in constructor to warm up the system
procedure loadNextChar (); virtual; abstract; // loads next char into mNextChar; #0 means 'eof'
public
- constructor Create ();
+ constructor Create (aopts: TOptions=[TOption.SignedNumbers]);
destructor Destroy (); override;
function isEOF (): Boolean; inline;
procedure expectTT (ttype: Integer);
function eatTT (ttype: Integer): Boolean;
- function expectDelim (const ch: AnsiChar): AnsiChar;
+ procedure expectDelim (const ch: AnsiChar);
+ function expectDelims (const ch: TAnsiCharSet): AnsiChar;
function eatDelim (const ch: AnsiChar): Boolean;
+ function isDelim (const ch: AnsiChar): Boolean; inline;
+
public
- property allowSignedNumbers: Boolean read mAllowSignedNumbers write mAllowSignedNumbers;
+ property options: TOptions read mOptions write mOptions;
public
property col: Integer read mCol;
procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
public
- constructor Create (const fname: AnsiString);
- constructor Create (st: TStream; astOwned: Boolean=true); // will take ownership on st by default
+ constructor Create (const fname: AnsiString; aopts: TOptions=[TOption.SignedNumbers]);
+ constructor Create (st: TStream; astOwned: Boolean=true; aopts: TOptions=[TOption.SignedNumbers]);
destructor Destroy (); override;
end;
procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
public
- constructor Create (const astr: AnsiString);
+ constructor Create (const astr: AnsiString; aopts: TOptions=[TOption.SignedNumbers]);
destructor Destroy (); override;
end;
// ////////////////////////////////////////////////////////////////////////// //
-function StrEqu (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
-
-
-// ////////////////////////////////////////////////////////////////////////// //
-constructor TTextParser.Create ();
+constructor TTextParser.Create (aopts: TOptions=[TOption.SignedNumbers]);
begin
mLine := 1;
mCol := 1;
mTokStr := '';
mTokChar := #0;
mTokInt := 0;
- mAllowSignedNumbers := true;
- warmup(); // change `mAllowSignedNumbers` there, if necessary
+ mOptions := aopts;
+ warmup();
skipToken();
end;
end;
continue;
end;
+ end
+ else if (curChar = '(') and (nextChar = '*') then
+ begin
+ // pascal comment; skip comment start
+ skipChar();
+ skipChar();
+ while not isEOF do
+ begin
+ if (curChar = '*') and (nextChar = ')') then
+ begin
+ // skip comment end
+ skipChar();
+ skipChar();
+ break;
+ end;
+ skipChar();
+ end;
+ continue;
end;
if (curChar > ' ') then break;
skipChar(); // skip blank
base: Integer = -1;
n: Integer;
begin
- if mAllowSignedNumbers then
+ if (TOption.SignedNumbers in mOptions) then
begin
if (curChar = '+') or (curChar = '-') then
begin
while (curChar = '_') or ((curChar >= '0') and (curChar <= '9')) or
((curChar >= 'A') and (curChar <= 'Z')) or
((curChar >= 'a') and (curChar <= 'z')) or
- (curChar >= #128) do
+ (curChar >= #128) or
+ ((TOption.DollarIsId in mOptions) and (curChar = '$')) or
+ ((TOption.DotIsId in mOptions) and (curChar = '.') and (nextChar <> '.')) do
begin
mTokStr += curChar;
skipChar();
result := true;
// number?
- if mAllowSignedNumbers and ((curChar = '+') or (curChar = '-')) then begin parseInt(); exit; end;
+ if (TOption.SignedNumbers in mOptions) and ((curChar = '+') or (curChar = '-')) then begin parseInt(); exit; end;
if (curChar >= '0') and (curChar <= '9') then begin parseInt(); exit; end;
// string?
// identifier?
if (curChar = '_') or ((curChar >= 'A') and (curChar <= 'Z')) or ((curChar >= 'a') and (curChar <= 'z')) or (curChar >= #128) then begin parseId(); exit; end;
+ if (TOption.DollarIsId in mOptions) and (curChar = '$') then begin parseId(); exit; end;
+ if (TOption.DotIsId in mOptions) and (curChar = '.') and (nextChar <> '.') then begin parseId(); exit; end;
// known delimiters?
mTokChar := curChar;
'>': begin mTokType := TTGreatEqu; mTokStr := '>='; skipChar(); exit; end;
'!': begin mTokType := TTNotEqu; mTokStr := '!='; skipChar(); exit; end;
'=': begin mTokType := TTEqu; mTokStr := '=='; skipChar(); exit; end;
+ ':': begin mTokType := TTAss; mTokStr := ':='; skipChar(); exit; end;
+ end;
+ end
+ else if (mTokChar = curChar) then
+ begin
+ case mTokChar of
+ '<': begin mTokType := TTShl; mTokStr := '<<'; skipChar(); exit; end;
+ '>': begin mTokType := TTShr; mTokStr := '>>'; skipChar(); exit; end;
+ '&': begin mTokType := TTLogAnd; mTokStr := '&&'; skipChar(); exit; end;
+ '|': begin mTokType := TTLogOr; mTokStr := '||'; skipChar(); exit; end;
+ end;
+ end
+ else
+ begin
+ case mTokChar of
+ '<': if (curChar = '>') then begin mTokType := TTNotEqu; mTokStr := '<>'; skipChar(); exit; end;
+ '.': if (curChar = '.') then begin mTokType := TTDotDot; mTokStr := '..'; skipChar(); exit; end;
end;
- end;
- case mTokChar of
- ',': mTokType := TTComma;
- ':': mTokType := TTColon;
- ';': mTokType := TTSemi;
- '{': mTokType := TTBegin;
- '}': mTokType := TTEnd;
- '&': if (curChar = '&') then begin mTokType := TTLogAnd; mTokStr := '&&'; skipChar(); exit; end;
- '|': if (curChar = '|') then begin mTokType := TTLogOr; mTokStr := '||'; skipChar(); exit; end;
end;
end;
procedure TTextParser.expectId (const aid: AnsiString);
begin
- if (mTokType <> TTId) or (not StrEqu(mTokStr, aid)) then raise Exception.Create('identifier '''+aid+''' expected');
+ if (mTokType <> TTId) or (mTokStr <> aid) then raise Exception.Create('identifier '''+aid+''' expected');
skipToken();
end;
function TTextParser.eatId (const aid: AnsiString): Boolean;
begin
- result := false;
- if (mTokType <> TTId) or (not StrEqu(mTokStr, aid)) then exit;
- result := true;
- skipToken();
+ result := (mTokType = TTId) and (mTokStr = aid);
+ if result then skipToken();
end;
end;
-function TTextParser.expectDelim (const ch: AnsiChar): AnsiChar;
+procedure TTextParser.expectDelim (const ch: AnsiChar);
+begin
+ if (mTokType <> TTDelim) or (mTokChar <> ch) then raise Exception.CreateFmt('delimiter ''%s'' expected', [ch]);
+ skipToken();
+end;
+
+
+function TTextParser.expectDelims (const ch: TAnsiCharSet): AnsiChar;
begin
- if (mTokType <> TTDelim) then raise Exception.Create(Format('delimiter ''%s'' expected', [ch]));
+ if (mTokType <> TTDelim) then raise Exception.Create('delimiter expected');
+ if not (mTokChar in ch) then raise Exception.Create('delimiter expected');
result := mTokChar;
skipToken();
end;
function TTextParser.eatDelim (const ch: AnsiChar): Boolean;
begin
- result := false;
- if (mTokType <> TTDelim) or (mTokChar <> ch) then exit;
- result := true;
- skipToken();
+ result := (mTokType = TTDelim) and (mTokChar = ch);
+ if result then skipToken();
+end;
+
+
+function TTextParser.isDelim (const ch: AnsiChar): Boolean; inline;
+begin
+ result := (mTokType = TTDelim) and (mTokChar = ch);
end;
// ////////////////////////////////////////////////////////////////////////// //
-constructor TFileTextParser.Create (const fname: AnsiString);
+constructor TFileTextParser.Create (const fname: AnsiString; aopts: TOptions=[TOption.SignedNumbers]);
begin
mBuffer := nil;
mFile := openDiskFileRO(fname);
mBufPos := 0;
mBufLen := mFile.Read(mBuffer^, BufSize);
if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error');
- inherited Create();
+ inherited Create(aopts);
end;
-constructor TFileTextParser.Create (st: TStream; astOwned: Boolean=true);
+constructor TFileTextParser.Create (st: TStream; astOwned: Boolean=true; aopts: TOptions=[TOption.SignedNumbers]);
begin
if (st = nil) then raise Exception.Create('cannot create parser for nil stream');
mFile := st;
mBufPos := 0;
mBufLen := mFile.Read(mBuffer^, BufSize);
if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error');
- inherited Create();
+ inherited Create(aopts);
end;
// ////////////////////////////////////////////////////////////////////////// //
-constructor TStrTextParser.Create (const astr: AnsiString);
+constructor TStrTextParser.Create (const astr: AnsiString; aopts: TOptions=[TOption.SignedNumbers]);
begin
mStr := astr;
mPos := 1;
- inherited Create();
+ inherited Create(aopts);
end;