X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxdynrec.pas;h=511c82dd0fd2ba8aeafa406cc5ef26e714318148;hb=987c4a835a103345b59937e8e1be8524a6228712;hp=223dc51518c92d89b11e8ad9cb957c89c57ba1aa;hpb=bee209fb79c0f1ce65b16cddd82c321488c4ba90;p=d2df-sdl.git diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index 223dc51..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,10 +54,10 @@ 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, TList, TTrigData); + TType = (TBool, TChar, TByte, TUByte, TShort, TUShort, TInt, TUInt, TString, TPoint, TSize, TColor, TList, TTrigData); // TPoint: pair of Integers // TSize: pair of UShorts // TList: actually, array of records @@ -71,9 +71,13 @@ type private mOwner: TDynRecord; // owner record mName: AnsiString; // field name + mTip: AnsiString; // short tip + mHelp: AnsiString; // long help mType: TType; // field type mIVal: Integer; // for all integer types mIVal2: Integer; // for point and size + mIVal3: Integer; // for TColor + mIVal4: Integer; // for TColor mSVal: AnsiString; // string; for byte and char arrays mRVal: TDynRecList; // for list mRHash: THashStrInt; // id -> index in mRVal @@ -92,7 +96,7 @@ type // default value mDefUnparsed: AnsiString; mDefSVal: AnsiString; // default string value - mDefIVal, mDefIVal2: Integer; // default integer values + mDefIVal, mDefIVal2, mDefIVal3, mDefIVal4: Integer; // default integer values mDefRecRef: TDynRecord; mEBS: TEBS; // complex type type mEBSTypeName: AnsiString; // name of enum, bitset or record @@ -160,6 +164,18 @@ type // supports `for rec in field do` (for lists) function GetEnumerator (): TDynRecList.TEnumerator; inline; + function getRed (): Integer; inline; + procedure setRed (v: Integer); inline; + + function getGreen (): Integer; inline; + procedure setGreen (v: Integer); inline; + + function getBlue (): Integer; inline; + procedure setBlue (v: Integer); inline; + + function getAlpha (): Integer; inline; + procedure setAlpha (v: Integer); inline; + public // text parser and writer procedure parseValue (pr: TTextParser); @@ -167,7 +183,7 @@ type // binary parser and writer (DO NOT USE!) procedure parseBinValue (st: TStream); - procedure writeBinTo (st: TStream); + procedure writeBinTo (var hasLostData: Boolean; st: TStream); public // the following functions are here only for 'mapgen'! DO NOT USE! @@ -182,6 +198,12 @@ type 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 ival3: Integer read mIVal3; // for `TColor`: blue + property ival4: Integer read mIVal4; // for `TColor`: alpha + property red: Integer read getRed write setRed; // for `TColor`: red + property green: Integer read getGreen write setGreen; // for `TColor`: green + property blue: Integer read getBlue write setBlue; // for `TColor`: blue + property alpha: Integer read getAlpha write setAlpha; // for `TColor`: alpha 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 @@ -197,6 +219,9 @@ type // field value as Variant property value: Variant read getVar write setVar; + property tip: AnsiString read mTip; + property help: AnsiString read mHelp; + 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; @@ -208,15 +233,18 @@ type property hasTPrefix: Boolean read mAsT; property separatePasFields: Boolean read mSepPosSize; property binOfs: Integer read mBinOfs; + property equToDefault: Boolean read isDefaultValue; end; // record, either with actual values, or with type definitions - TDynRecord = class + TDynRecord = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} private mOwner: TDynMapDef; mId: AnsiString; mTypeName: AnsiString; + mTip: AnsiString; // short tip + mHelp: AnsiString; // long help mSize: Integer; mFields: TDynFieldList; {$IF DEFINED(XDYNREC_USE_FIELDHASH)} @@ -313,7 +341,7 @@ type // binary parser and writer (DO NOT USE!) procedure parseBinValue (st: TStream; forceData: Boolean=false); - procedure writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false); + procedure writeBinTo (var hasLostData: Boolean; st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false); public property mapdef: TDynMapDef read mOwner; @@ -330,6 +358,9 @@ type 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? + property tip: AnsiString read mTip; + property help: AnsiString read mHelp; + public // user fields; user can add arbitrary custom fields // by default, any user field will be marked as "internal" @@ -344,11 +375,13 @@ type // bitset/enum definition - TDynEBS = class + TDynEBS = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} private mOwner: TDynMapDef; mIsEnum: Boolean; mTypeName: AnsiString; + mTip: AnsiString; // short tip + mHelp: AnsiString; // long help mIds: array of AnsiString; mVals: array of Integer; mMaxName: AnsiString; // MAX field @@ -379,12 +412,15 @@ 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; end; // parsed "mapdef.txt" - TDynMapDef = class + TDynMapDef = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} public recTypes: TDynRecList; // [0] is always header trigTypes: TDynRecList; // trigdata @@ -421,7 +457,7 @@ type public // parse text or binary map, return new header record // WARNING! stream must be seekable - function parseMap (st: TStream): TDynRecord; + function parseMap (st: TStream; wasBinary: PBoolean=nil): TDynRecord; // returns `true` if the given stream can be a map file // stream position is 0 on return @@ -453,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} // ////////////////////////////////////////////////////////////////////////// // @@ -511,7 +550,7 @@ begin if (mType = TType.TList) then begin mRVal := TDynRecList.Create(); - mRHash := hashNewStrInt(); + mRHash := THashStrInt.Create(); end; end; @@ -599,9 +638,13 @@ end; procedure TDynField.cleanup (); begin mName := ''; + mTip := ''; + mHelp := ''; mType := TType.TInt; mIVal := 0; mIVal2 := 0; + mIVal3 := 0; + mIVal4 := 0; // default alpha value mSVal := ''; mRVal.Free(); mRVal := nil; @@ -620,6 +663,8 @@ begin mDefSVal := ''; mDefIVal := 0; mDefIVal2 := 0; + mDefIVal3 := 0; + mDefIVal4 := 0; // default value for alpha mDefRecRef := nil; mEBS := TEBS.TNone; mEBSTypeName := ''; @@ -642,14 +687,18 @@ begin result.mOwner := mOwner; if (newOwner <> nil) then result.mOwner := newOwner else result.mOwner := mOwner; result.mName := mName; + result.mTip := mTip; + result.mHelp := mHelp; result.mType := mType; result.mIVal := mIVal; result.mIVal2 := mIVal2; + result.mIVal3 := mIVal3; + result.mIVal4 := mIVal4; result.mSVal := mSVal; 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; @@ -668,6 +717,8 @@ begin result.mDefSVal := mDefSVal; result.mDefIVal := mDefIVal; result.mDefIVal2 := mDefIVal2; + result.mDefIVal3 := mDefIVal3; + result.mDefIVal4 := mDefIVal4; result.mDefRecRef := mDefRecRef; result.mEBS := mEBS; result.mEBSTypeName := mEBSTypeName; @@ -742,6 +793,7 @@ begin TType.TString: result := mSVal; TType.TPoint: raise TDynRecException.Create('cannot convert point field to variant'); TType.TSize: raise TDynRecException.Create('cannot convert size field to variant'); + TType.TColor: raise TDynRecException.Create('cannot convert color 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'); @@ -857,6 +909,8 @@ begin TType.TPoint, TType.TSize: result := ((mIVal = fld.mIVal) and (mIVal2 = fld.mIVal2)); + TType.TColor: + result := ((mIVal = fld.mIVal) and (mIVal2 = fld.mIVal2) and (mIVal3 = fld.mIVal3) and (mIVal4 = fld.mIVal4)); TType.TList: result := false; TType.TTrigData: begin @@ -881,11 +935,24 @@ begin end; +function TDynField.getRed (): Integer; inline; begin result := mIVal; if (result < 0) then result := 0 else if (result > 255) then result := 255; end; +procedure TDynField.setRed (v: Integer); inline; begin if (v < 0) then v := 0 else if (v > 255) then v := 255; mIVal := v; end; + +function TDynField.getGreen (): Integer; inline; begin result := mIVal2; if (result < 0) then result := 0 else if (result > 255) then result := 255; end; +procedure TDynField.setGreen (v: Integer); inline; begin if (v < 0) then v := 0 else if (v > 255) then v := 255; mIVal2 := v; end; + +function TDynField.getBlue (): Integer; inline; begin result := mIVal3; if (result < 0) then result := 0 else if (result > 255) then result := 255; end; +procedure TDynField.setBlue (v: Integer); inline; begin if (v < 0) then v := 0 else if (v > 255) then v := 255; mIVal3 := v; end; + +function TDynField.getAlpha (): Integer; inline; begin result := mIVal4; if (result < 0) then result := 0 else if (result > 255) then result := 255; end; +procedure TDynField.setAlpha (v: Integer); inline; begin if (v < 0) then v := 0 else if (v > 255) then v := 255; mIVal4 := v; end; + + procedure TDynField.parseDefaultValue (); var stp: TTextParser = nil; oSVal: AnsiString; - oIVal, oIVal2: Integer; + oIVal, oIVal2, oIVal3, oIVal4: Integer; oRRef: TDynRecord; oDef: Boolean; begin @@ -894,6 +961,8 @@ begin mDefSVal := ''; mDefIVal := 0; mDefIVal2 := 0; + mDefIVal3 := 0; + mDefIVal4 := 0; // default value for alpha mDefRecRef := nil; end else @@ -901,19 +970,26 @@ begin oSVal := mSVal; oIVal := mIVal; oIVal2 := mIVal2; + oIVal3 := mIVal3; + oIVal4 := mIVal4; oRRef := mRecRef; oDef := mDefined; try stp := TStrTextParser.Create(mDefUnparsed+';'); parseValue(stp); + //if (mType = TType.TColor) then writeln('4=[', mIVal4, ']'); mDefSVal := mSVal; mDefIVal := mIVal; mDefIVal2 := mIVal2; + mDefIVal3 := mIVal3; + mDefIVal4 := mIVal4; mDefRecRef := mRecRef; finally mSVal := oSVal; mIVal := oIVal; mIVal2 := oIVal2; + mIVal3 := oIVal3; + mIVal4 := oIVal4; mRecRef := oRRef; mDefined := oDef; stp.Free(); @@ -935,6 +1011,9 @@ begin mSVal := mDefSVal; mIVal := mDefIVal; mIVal2 := mDefIVal2; + mIVal3 := mDefIVal3; + mIVal4 := mDefIVal4; + //if (mType = TType.TColor) then writeln('4=[', mDefIVal4, ']'); mDefined := true; end; @@ -947,6 +1026,7 @@ begin case mType of TType.TChar, TType.TString: result := (mSVal = mDefSVal); TType.TPoint, TType.TSize: result := (mIVal = mDefIVal2) and (mIVal2 = mDefIVal2); + TType.TColor: result := (mIVal = mDefIVal2) and (mIVal2 = mDefIVal2) and (mIVal3 = mDefIVal3) and (mIVal4 = mDefIVal4); TType.TList, TType.TTrigData: result := false; // no default values for those types else result := (mIVal = mDefIVal); end; @@ -1018,6 +1098,7 @@ begin TType.TString: result := 'string'; TType.TPoint: result := 'point'; TType.TSize: result := 'size'; + TType.TColor: result := 'color'; TType.TList: result := 'array'; TType.TTrigData: result := 'trigdata'; else raise TDynRecException.Create('ketmar forgot to handle some field type'); @@ -1060,7 +1141,7 @@ var ainternal: Boolean; writedef: Boolean; defstr: AnsiString; - defint, defint2: Integer; + defint, defint2, defint3, defint4: Integer; hasdefStr: Boolean; hasdefInt: Boolean; hasdefId: Boolean; @@ -1070,6 +1151,7 @@ var asmonid: Boolean; defech: AnsiChar; xalias: AnsiString; + atip, ahelp: AnsiString; begin fldname := ''; fldtype := ''; @@ -1083,6 +1165,8 @@ begin defstr := ''; defint := 0; defint2 := 0; + defint3 := 0; + defint4 := 0; hasdefStr := false; hasdefInt := false; hasdefId := false; @@ -1091,11 +1175,13 @@ begin lmaxdim := -1; lebs := TDynField.TEBS.TNone; xalias := ''; + atip := ''; + 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 @@ -1120,6 +1206,20 @@ begin continue; end; + if pr.eatId('tip') then + begin + if (Length(atip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for field ''%s''', [fldname]); + atip := pr.expectStr(false); + continue; + end; + + if pr.eatId('help') then + begin + if (Length(ahelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for field ''%s''', [fldname]); + ahelp := pr.expectStr(false); + continue; + end; + if pr.eatId('offset') then begin if (fldofs >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' offset', [fldname]); @@ -1181,6 +1281,11 @@ begin if pr.eatDelim('[') then defech := ']' else begin pr.expectDelim('('); defech := ')'; end; defint := pr.expectInt(); defint2 := pr.expectInt(); + if (pr.tokType = pr.TTInt) then + begin + defint3 := pr.expectInt(); + if (pr.tokType = pr.TTInt) then defint4 := pr.expectInt(); + end; pr.expectDelim(defech); end; else @@ -1209,7 +1314,7 @@ begin lebs := TDynField.TEBS.TRec; end; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); // create field mName := fldname; @@ -1225,6 +1330,7 @@ begin else if (fldtype = 'string') then mType := TType.TString else if (fldtype = 'point') then mType := TType.TPoint else if (fldtype = 'size') then mType := TType.TSize + else if (fldtype = 'color') then mType := TType.TColor else if (fldtype = 'trigdata') then mType := TType.TTrigData else begin @@ -1267,6 +1373,7 @@ begin begin if (mType = TType.TPoint) then self.mDefUnparsed := Format('(%d %d)', [defint, defint2]) else if (mType = TType.TSize) then self.mDefUnparsed := Format('[%d %d]', [defint, defint2]) + else if (mType = TType.TColor) then self.mDefUnparsed := Format('(%d %d %d %d)', [defint, defint2, defint3, defint4]) else self.mDefUnparsed := Format('%d', [defint]); end; @@ -1282,6 +1389,8 @@ begin self.mWriteDef := writedef; self.mInternal := ainternal; self.mAlias := xalias; + self.mTip := atip; + self.mHelp := ahelp; end; @@ -1292,7 +1401,7 @@ begin end; -procedure TDynField.writeBinTo (st: TStream); +procedure TDynField.writeBinTo (var hasLostData: Boolean; st: TStream); var s: AnsiString; f: Integer; @@ -1319,7 +1428,7 @@ begin if (mRecRef <> nil) then begin ws := TSFSMemoryChunkStream.Create(buf, mMaxDim); - mRecRef.writeBinTo(ws, mMaxDim); // as trigdata + mRecRef.writeBinTo(hasLostData, ws, mMaxDim); // as trigdata end; st.WriteBuffer(buf^, mMaxDim); finally @@ -1433,16 +1542,20 @@ begin writeInt(st, Word(mIVal2)); exit; end; - TType.TList: + TType.TColor: begin - assert(false); + if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('color array in field ''%s'' cannot be written', [mName]); + writeInt(st, Byte(mIVal)); + writeInt(st, Byte(mIVal2)); + writeInt(st, Byte(mIVal3)); + //writeInt(st, Byte(mIVal4)); // the only place we have RGB in binary map is effect trigger, and it has no alpha + if (mIVal4 <> 255) then hasLostData := true; exit; end; + TType.TList: + raise TDynRecException.Create('cannot write lists to binary format'); TType.TTrigData: - begin - assert(false); - exit; - end; + raise TDynRecException.Create('cannot write triggers to binary format (internal error)'); else raise TDynRecException.Create('ketmar forgot to handle some field type'); end; end; @@ -1526,7 +1639,7 @@ begin begin if (es.mVals[f] = mask) then begin - if not first then wr.put('+') else first := false; + if not first then wr.put(' | ') else first := false; wr.put(es.mIds[f]); found := true; break; @@ -1577,6 +1690,12 @@ begin wr.put('(%d %d);'#10, [mIVal, mIVal2]); exit; end; + TType.TColor: + begin + if (mIVal3 = 255) then wr.put('(%d %d %d);'#10, [mIVal, mIVal2, mIVal3]) + else wr.put('(%d %d %d %d);'#10, [mIVal, mIVal2, mIVal3, mIVal4]); + exit; + end; TType.TList: begin assert(false); @@ -1759,6 +1878,16 @@ begin mDefined := true; exit; end; + TType.TColor: + begin + mIVal := readByte(st); + mIVal2 := readByte(st); + mIVal3 := readByte(st); + //mIVal4 := readByte(st); // the only place we have RGB in binary map is effect trigger, and it has no alpha + mIVal4 := 255; + mDefined := true; + exit; + end; TType.TList: begin assert(false); @@ -1792,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; @@ -1801,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 @@ -1824,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 @@ -1849,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; @@ -1867,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 @@ -1884,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: @@ -1905,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'); @@ -1918,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: @@ -1938,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, @@ -1991,16 +2119,39 @@ begin mIVal := pr.expectInt(); if (mType = TType.TSize) then begin - if (mIVal < 0) or (mIVal > 32767) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]); + if (mIVal < 0) or (mIVal > 65535) 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 TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]); + if (mIVal2 < 0) or (mIVal2 > 65535) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]); + end; + mDefined := true; + pr.expectDelim(edim); + pr.expectDelim(';'); + exit; + end; + TType.TColor: + begin + if pr.eatDelim('[') then edim := ']' else begin pr.expectDelim('('); edim := ')'; end; + mIVal := pr.expectInt(); + if (mIVal < 0) or (mIVal > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]); + mIVal2 := pr.expectInt(); + if (mIVal2 < 0) or (mIVal2 > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]); + mIVal3 := pr.expectInt(); + if (mIVal3 < 0) or (mIVal3 > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]); + if (pr.tokType = pr.TTInt) then + begin + mIVal4 := pr.expectInt(); + if (mIVal4 < 0) or (mIVal4 > 255) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]); + end + else + begin + mIVal4 := 255; end; mDefined := true; pr.expectDelim(edim); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TList: @@ -2205,6 +2356,8 @@ begin result.mOwner := mOwner; result.mId := mId; result.mTypeName := mTypeName; + result.mTip := mTip; + result.mHelp := mHelp; result.mSize := mSize; result.mHeader := mHeader; result.mBinBlock := mBinBlock; @@ -2282,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; @@ -2440,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]); @@ -2458,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 @@ -2477,12 +2630,24 @@ begin if (mBinBlock < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' binblock: %d', [mTypeName, mBinBlock]); continue; end; + if pr.eatId('tip') then + begin + if (Length(mTip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for record ''%s''', [mTypeName]); + mTip := pr.expectStr(false); + continue; + end; + if pr.eatId('help') then + begin + if (Length(mHelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate help definition for record ''%s''', [mTypeName]); + mHelp := pr.expectStr(false); + continue; + end; 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 @@ -2494,7 +2659,7 @@ begin end; // done with field end; - pr.expectTT(pr.TTEnd); + pr.expectDelim('}'); end; @@ -2569,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, ')'); @@ -2579,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; @@ -2669,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); @@ -2676,14 +2850,13 @@ begin end; -procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false); +procedure TDynRecord.writeBinTo (var hasLostData: Boolean; st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false); var fld: TDynField; rec, rv: TDynRecord; buf: PByte = nil; ws: TStream = nil; blk, blkmax: Integer; - //f, c: Integer; bufsz: Integer = 0; blksz: Integer; begin @@ -2708,11 +2881,15 @@ begin // record list? if (fld.mType = fld.TType.TList) then continue; // later if fld.mInternal then continue; - if (fld.mBinOfs < 0) then continue; + if (fld.mBinOfs < 0) then + begin + if not fld.equToDefault then hasLostData := true; + continue; + end; 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); + fld.writeBinTo(hasLostData, ws); end; // write block with normal fields @@ -2762,7 +2939,7 @@ begin if (rec = nil) then continue; if (rec.mBinBlock <> blk) then continue; if (ws = nil) then ws := TMemoryStream.Create(); - for rv in fld.mRVal do rv.writeBinTo(ws); + for rv in fld.mRVal do rv.writeBinTo(hasLostData, ws); end; end; // flush block @@ -2794,6 +2971,8 @@ procedure TDynRecord.writeTo (wr: TTextWriter; putHeader: Boolean=true); var fld: TDynField; rec: TDynRecord; + putTypeComment: Boolean; + f: Integer; begin if putHeader then begin @@ -2810,11 +2989,31 @@ begin if (fld.mType = fld.TType.TList) then begin if not mHeader then raise TDynRecException.Create('record list in non-header record'); - if (fld.mRVal <> nil) then + if (fld.mRVal <> nil) and (fld.mRVal.count > 0) then begin + putTypeComment := true; for rec in fld.mRVal do begin - if (Length(rec.mId) = 0) then continue; + if (rec = nil) or (Length(rec.mId) = 0) then continue; + if putTypeComment then + begin + wr.put(#10); + if (80-wr.curIndent*2 >= 2) then + begin + wr.putIndent(); + for f := wr.curIndent to 80-wr.curIndent do wr.put('/'); + wr.put(#10); + end; + putTypeComment := false; + wr.putIndent(); + wr.put('// '); + wr.put(fld.name); + wr.put(#10); + end + else + begin + wr.put(#10); + end; wr.putIndent(); rec.writeTo(wr, true); end; @@ -2872,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; @@ -2898,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 @@ -2919,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, '>'); @@ -2929,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, '>'); @@ -2961,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; @@ -3011,6 +3207,8 @@ procedure TDynEBS.cleanup (); begin mIsEnum := false; mTypeName := ''; + mTip := ''; + mHelp := ''; mIds := nil; mVals := nil; mMaxName := ''; @@ -3115,8 +3313,24 @@ begin mTypeName := pr.expectId(); mMaxVal := Integer($80000000); if mIsEnum then cv := 0 else cv := 1; - pr.expectTT(pr.TTBegin); - while (pr.tokType <> pr.TTEnd) do + while (not pr.isDelim('{')) do + begin + if pr.eatId('tip') then + begin + if (Length(mTip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for enum/bitset ''%s''', [mTypeName]); + mTip := pr.expectStr(false); + continue; + end; + if pr.eatId('help') then + begin + if (Length(mHelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate help definition for enum/bitset ''%s''', [mTypeName]); + mHelp := pr.expectStr(false); + continue; + end; + break; + end; + pr.expectDelim('{'); + while (not pr.isDelim('}')) do begin idname := pr.expectId(); for f := 0 to High(mIds) do @@ -3161,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 @@ -3401,11 +3615,12 @@ end; // WARNING! stream must be seekable -function TDynMapDef.parseMap (st: TStream): TDynRecord; +function TDynMapDef.parseMap (st: TStream; wasBinary: PBoolean=nil): TDynRecord; var sign: packed array[0..3] of AnsiChar; pr: TTextParser; begin + if (wasBinary <> nil) then wasBinary^ := false; st.position := 0; st.ReadBuffer(sign[0], 4); st.position := 0; @@ -3413,6 +3628,7 @@ begin begin if (sign[3] = #1) then begin + if (wasBinary <> nil) then wasBinary^ := true; result := parseBinMap(st); exit; end;