X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxdynrec.pas;h=511c82dd0fd2ba8aeafa406cc5ef26e714318148;hb=987c4a835a103345b59937e8e1be8524a6228712;hp=b65ab8a4af7b13fb8eb25f445f01442175050ca4;hpb=44b1b8d4008737947a55103121e2a607a1927a88;p=d2df-sdl.git diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index b65ab8a..511c82d 100644 --- a/src/shared/xdynrec.pas +++ b/src/shared/xdynrec.pas @@ -1,9 +1,8 @@ -(* Copyright (C) DooM 2D:Forever Developers +(* Copyright (C) Doom 2D: Forever Developers * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. + * the Free Software Foundation, version 3 of the License ONLY. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -21,6 +20,7 @@ interface uses SysUtils, Variants, Classes, + {$IFDEF USE_MEMPOOL}mempool,{$ENDIF} xparser, xstreams, utils, hashtable; @@ -54,7 +54,7 @@ type TDynEBSList = specialize TSimpleList; // this is base type for all scalars (and arrays) - TDynField = class + TDynField = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} public type TType = (TBool, TChar, TByte, TUByte, TShort, TUShort, TInt, TUInt, TString, TPoint, TSize, TColor, TList, TTrigData); @@ -238,7 +238,7 @@ type // record, either with actual values, or with type definitions - TDynRecord = class + TDynRecord = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} private mOwner: TDynMapDef; mId: AnsiString; @@ -375,7 +375,7 @@ type // bitset/enum definition - TDynEBS = class + TDynEBS = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} private mOwner: TDynMapDef; mIsEnum: Boolean; @@ -412,7 +412,7 @@ type property typeName: AnsiString read mTypeName; // 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; + property field[const aname: AnsiString]: Integer read getFieldByName; default; property tip: AnsiString read mTip; property help: AnsiString read mHelp; @@ -420,7 +420,7 @@ type // parsed "mapdef.txt" - TDynMapDef = class + TDynMapDef = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} public recTypes: TDynRecList; // [0] is always header trigTypes: TDynRecList; // trigdata @@ -489,12 +489,15 @@ type 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} // ////////////////////////////////////////////////////////////////////////// // @@ -547,7 +550,7 @@ begin if (mType = TType.TList) then begin mRVal := TDynRecList.Create(); - mRHash := hashNewStrInt(); + mRHash := THashStrInt.Create(); end; end; @@ -695,7 +698,7 @@ begin if (mRVal <> nil) then begin if (result.mRVal = nil) then result.mRVal := TDynRecList.Create(mRVal.count); - if (result.mRHash = nil) then result.mRHash := hashNewStrInt(); + if (result.mRHash = nil) then result.mRHash := THashStrInt.Create(); for rec in mRVal do result.addListItem(rec.clone(registerIn)); end; result.mRecRef := mRecRef; @@ -974,6 +977,7 @@ begin try stp := TStrTextParser.Create(mDefUnparsed+';'); parseValue(stp); + //if (mType = TType.TColor) then writeln('4=[', mIVal4, ']'); mDefSVal := mSVal; mDefIVal := mIVal; mDefIVal2 := mIVal2; @@ -1009,6 +1013,7 @@ begin mIVal2 := mDefIVal2; mIVal3 := mDefIVal3; mIVal4 := mDefIVal4; + //if (mType = TType.TColor) then writeln('4=[', mDefIVal4, ']'); mDefined := true; end; @@ -1174,9 +1179,9 @@ begin ahelp := ''; // field name - fldname := pr.expectStrOrId(); + fldname := pr.expectIdOrStr(); - while (pr.tokType <> pr.TTSemi) do + while (not pr.isDelim(';')) do begin if pr.eatId('type') then begin @@ -1309,7 +1314,7 @@ begin lebs := TDynField.TEBS.TRec; end; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); // create field mName := fldname; @@ -1916,7 +1921,7 @@ var 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; @@ -1925,12 +1930,11 @@ begin // 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 @@ -1948,7 +1952,7 @@ 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 @@ -1973,10 +1977,10 @@ begin 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; @@ -1991,10 +1995,10 @@ begin 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 @@ -2008,7 +2012,7 @@ begin mSVal := tk; //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal); mDefined := true; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TEBS.TBitSet: @@ -2029,7 +2033,7 @@ begin 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'); @@ -2042,7 +2046,7 @@ begin 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: @@ -2062,50 +2066,50 @@ begin 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, @@ -2124,7 +2128,7 @@ begin end; mDefined := true; pr.expectDelim(edim); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TColor: @@ -2147,7 +2151,7 @@ begin end; mDefined := true; pr.expectDelim(edim); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TList: @@ -2431,7 +2435,7 @@ begin if (fld.mRVal = nil) then begin fld.mRVal := TDynRecList.Create(); - fld.mRHash := hashNewStrInt(); + fld.mRHash := THashStrInt.Create(); end; result := fld.addListItem(rc); end; @@ -2589,7 +2593,7 @@ begin 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]); @@ -2607,8 +2611,8 @@ begin end else begin - mTypeName := pr.expectStrOrId(); - while (pr.tokType <> pr.TTBegin) do + mTypeName := pr.expectIdOrStr(); + while (not pr.isDelim('{')) do begin if pr.eatId('header') then begin mHeader := true; continue; end; if pr.eatId('size') then @@ -2641,9 +2645,9 @@ begin 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 @@ -2655,7 +2659,7 @@ begin end; // done with field end; - pr.expectTT(pr.TTEnd); + pr.expectDelim('}'); end; @@ -2730,7 +2734,10 @@ var 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], MSG_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, ')'); @@ -2740,7 +2747,7 @@ var end; for fld in rec.mFields do begin - //writeln(' ', fld.mName); + //if (fld.mName = 'ambient_color') then writeln('****', fld.mName); fld.fixDefaultValue(); // just in case end; end; @@ -2830,6 +2837,12 @@ begin //writeln('parsing ''', mName, '.', fld.mName, '''...'); fld.parseBinValue(mst); end; + // fix default values + for fld in mFields do + begin + if (fld.mType = TDynField.TType.TList) then continue; + fld.fixDefaultValue(); + end; finally mst.Free(); if (buf <> nil) then FreeMem(buf); @@ -3058,14 +3071,19 @@ var procedure linkNames (rec: TDynRecord); var fld: TDynField; - rt: TDynRecord; + rt, rvc: TDynRecord; begin + if (rec = nil) then exit; //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')'); for fld in rec.mFields do begin + if (fld.mType = TDynField.TType.TList) then + begin + for rvc in fld.mRVal do linkNames(rvc); + end; if (fld.mType = TDynField.TType.TTrigData) then begin - if (fld.mRecRef <> nil) then linkNames(fld.mRecRef); + //if (fld.mRecRef <> nil) then linkNames(fld.mRecRef); continue; end; if (Length(fld.mRecRefId) = 0) then continue; @@ -3084,14 +3102,14 @@ var for fld in rec.mFields do begin //writeln(' ', fld.mName); - fld.fixDefaultValue(); // just in case + fld.fixDefaultValue(); end; end; begin if (mOwner = nil) then raise TDynParseException.CreateFmt(pr, 'can''t parse record ''%s'' value without owner', [mTypeName]); - {$IF DEFINED(D2D_DYNREC_PROFILER)}stall := curTimeMicro();{$ENDIF} + {$IF DEFINED(D2D_DYNREC_PROFILER)}stall := getTimeMicro();{$ENDIF} // not a header? if not mHeader then @@ -3105,8 +3123,8 @@ begin 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, '>'); @@ -3115,31 +3133,31 @@ begin if mHeader then begin // add records with this type (if any) - {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := getTimeMicro();{$ENDIF} trc := mOwner.recType[pr.tokStr]; - {$IF DEFINED(D2D_DYNREC_PROFILER)}profFindRecType := curTimeMicro()-stt;{$ENDIF} + {$IF DEFINED(D2D_DYNREC_PROFILER)}profFindRecType := getTimeMicro()-stt;{$ENDIF} if (trc <> nil) then begin - {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := getTimeMicro();{$ENDIF} rec := trc.clone(mHeaderRec); - {$IF DEFINED(D2D_DYNREC_PROFILER)}profCloneRec := curTimeMicro()-stt;{$ENDIF} + {$IF DEFINED(D2D_DYNREC_PROFILER)}profCloneRec := getTimeMicro()-stt;{$ENDIF} rec.mHeaderRec := mHeaderRec; // on error, it will be freed by memowner pr.skipToken(); rec.parseValue(pr); - {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := getTimeMicro();{$ENDIF} addRecordByType(rec.mTypeName, rec); - {$IF DEFINED(D2D_DYNREC_PROFILER)}profAddRecByType := curTimeMicro()-stt;{$ENDIF} + {$IF DEFINED(D2D_DYNREC_PROFILER)}profAddRecByType := getTimeMicro()-stt;{$ENDIF} continue; end; end; // fields - {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := getTimeMicro();{$ENDIF} //writeln('0: <', mName, '.', pr.tokStr, '>'); fld := field[pr.tokStr]; //writeln('1: <', mName, '.', pr.tokStr, '>'); - {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF} + {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := getTimeMicro()-stt;{$ENDIF} if (fld <> nil) then begin //writeln('2: <', mName, '.', pr.tokStr, '>'); @@ -3147,34 +3165,26 @@ begin if fld.internal then raise TDynParseException.CreateFmt(pr, 'internal field ''%s'' in record ''%s''', [fld.mName, mTypeName]); pr.skipToken(); // skip field name //writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType); - {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := getTimeMicro();{$ENDIF} fld.parseValue(pr); - {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldValParsing := curTimeMicro()-stt;{$ENDIF} + {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldValParsing := getTimeMicro()-stt;{$ENDIF} continue; end; // 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 // link fields - for fld in mFields do - begin - if (fld.mType <> TDynField.TType.TList) then continue; - for rec in fld.mRVal do linkNames(rec); - end; + linkNames(self); + for rec in mRec2Free do if (rec <> nil) then linkNames(rec); end; - - // fix field defaults - {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} - for fld in mFields do fld.fixDefaultValue(); - {$IF DEFINED(D2D_DYNREC_PROFILER)}profFixDefaults := curTimeMicro()-stt;{$ENDIF} //writeln('done parsing record <', mName, '>'); - //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', curTimeMicro()-stall);{$ENDIF} - {$IF DEFINED(D2D_DYNREC_PROFILER)}profRecValParse := curTimeMicro()-stall;{$ENDIF} + //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', getTimeMicro()-stall);{$ENDIF} + {$IF DEFINED(D2D_DYNREC_PROFILER)}profRecValParse := getTimeMicro()-stall;{$ENDIF} end; @@ -3303,7 +3313,7 @@ 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 @@ -3319,8 +3329,8 @@ 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 @@ -3365,11 +3375,11 @@ begin 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