X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxdynrec.pas;h=53bda03d96112b758ace00a676b9b235fc0cb59c;hb=9785609d62537953358024080b20ed999a66e751;hp=6c4e376194b85e63beb7f3572b4cd389a5446e3e;hpb=6fdaf7454535407de0331bdc6b96e538919525a6;p=d2df-sdl.git diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index 6c4e376..53bda03 100644 --- a/src/shared/xdynrec.pas +++ b/src/shared/xdynrec.pas @@ -57,7 +57,7 @@ type TDynField = class 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 @@ -132,6 +136,7 @@ type protected // returns `true` for duplicate record id function addListItem (rec: TDynRecord): Boolean; inline; + function removeListItem (const aid: AnsiString): TDynRecord; // returns nil or removed record public // get string name for the given type @@ -159,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); @@ -166,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! @@ -181,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 @@ -196,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; @@ -207,6 +233,7 @@ type property hasTPrefix: Boolean read mAsT; property separatePasFields: Boolean read mSepPosSize; property binOfs: Integer read mBinOfs; + property equToDefault: Boolean read isDefaultValue; end; @@ -215,7 +242,9 @@ type private mOwner: TDynMapDef; mId: AnsiString; - mName: AnsiString; + mTypeName: AnsiString; + mTip: AnsiString; // short tip + mHelp: AnsiString; // long help mSize: Integer; mFields: TDynFieldList; {$IF DEFINED(XDYNREC_USE_FIELDHASH)} @@ -253,6 +282,8 @@ type function getUserVar (const aname: AnsiString): Variant; procedure setUserVar (const aname: AnsiString; val: Variant); + procedure clearRefRecs (rec: TDynRecord); + protected function findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord; function findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer; @@ -283,8 +314,22 @@ type // only for headers: create new record with the given type // will return cloned record ready for use, or `nil` on unknown type name + // `aid` must not be empty, and must be unique function newTypedRecord (const atypename, aid: AnsiString): TDynRecord; + // remove record with the given type and id + // return `true` if record was successfully found and removed + // this will do all necessary recref cleanup too + // WARNING: not tested yet + function removeTypedRecord (const atypename, aid: AnsiString): Boolean; + + //TODO: + // [.] API to create triggers + // [.] API to properly remove triggers (remove trigdata) + // [.] check if `removeTypedRecord()` does the right thing with inline records + // [.] for fields: assigning `recref` should remove previously assigned inline record (record without id) + // [.] other API i forgot + public // text parser // `beginEaten`: `true` if "{" was eaten @@ -296,12 +341,12 @@ 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; property id: AnsiString read mId; // record id in text map - property typeName: AnsiString read mName; // record type name (like "panel", or "trigger") + property typeName: AnsiString read mTypeName; // 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 @@ -313,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" @@ -331,7 +379,9 @@ type private mOwner: TDynMapDef; mIsEnum: Boolean; - mName: AnsiString; + mTypeName: AnsiString; + mTip: AnsiString; // short tip + mHelp: AnsiString; // long help mIds: array of AnsiString; mVals: array of Integer; mMaxName: AnsiString; // MAX field @@ -359,10 +409,13 @@ type public property mapdef: TDynMapDef read mOwner; - property typeName: AnsiString read mName; // enum/bitset type name + 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 tip: AnsiString read mTip; + property help: AnsiString read mHelp; end; @@ -404,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 @@ -582,9 +635,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; @@ -603,6 +660,8 @@ begin mDefSVal := ''; mDefIVal := 0; mDefIVal2 := 0; + mDefIVal3 := 0; + mDefIVal4 := 0; // default value for alpha mDefRecRef := nil; mEBS := TEBS.TNone; mEBSTypeName := ''; @@ -625,9 +684,13 @@ 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 @@ -651,6 +714,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; @@ -725,6 +790,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'); @@ -840,6 +906,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 @@ -864,11 +932,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 @@ -877,6 +958,8 @@ begin mDefSVal := ''; mDefIVal := 0; mDefIVal2 := 0; + mDefIVal3 := 0; + mDefIVal4 := 0; // default value for alpha mDefRecRef := nil; end else @@ -884,19 +967,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(); @@ -912,12 +1002,15 @@ begin if not mHasDefault then begin if mInternal then exit; - raise TDynRecException.CreateFmt('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.mTypeName]); end; if (mEBS = TEBS.TRec) then mRecRef := mDefRecRef; mSVal := mDefSVal; mIVal := mDefIVal; mIVal2 := mDefIVal2; + mIVal3 := mDefIVal3; + mIVal4 := mDefIVal4; + //if (mType = TType.TColor) then writeln('4=[', mDefIVal4, ']'); mDefined := true; end; @@ -930,6 +1023,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; @@ -967,6 +1061,26 @@ begin end; +function TDynField.removeListItem (const aid: AnsiString): TDynRecord; +var + f, idx: Integer; +begin + result := nil; + if mRHash.get(aid, idx) then + begin + assert((idx >= 0) and (idx < mRVal.count)); + result := mRVal[idx]; + // fix hash and list + for f := idx+1 to mRVal.count-1 do + begin + if (Length(mRVal[f].mId) > 0) then mRHash.put(mRVal[f].mId, f-1); + end; + mRHash.del(aid); + mRVal.delete(idx); + end; +end; + + class function TDynField.getTypeName (t: TType): AnsiString; begin case t of @@ -981,6 +1095,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'); @@ -1023,7 +1138,7 @@ var ainternal: Boolean; writedef: Boolean; defstr: AnsiString; - defint, defint2: Integer; + defint, defint2, defint3, defint4: Integer; hasdefStr: Boolean; hasdefInt: Boolean; hasdefId: Boolean; @@ -1033,6 +1148,7 @@ var asmonid: Boolean; defech: AnsiChar; xalias: AnsiString; + atip, ahelp: AnsiString; begin fldname := ''; fldtype := ''; @@ -1046,6 +1162,8 @@ begin defstr := ''; defint := 0; defint2 := 0; + defint3 := 0; + defint4 := 0; hasdefStr := false; hasdefInt := false; hasdefId := false; @@ -1054,6 +1172,8 @@ begin lmaxdim := -1; lebs := TDynField.TEBS.TNone; xalias := ''; + atip := ''; + ahelp := ''; // field name fldname := pr.expectStrOrId(); @@ -1083,6 +1203,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]); @@ -1144,6 +1278,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 @@ -1188,6 +1327,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 @@ -1230,6 +1370,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; @@ -1245,6 +1386,8 @@ begin self.mWriteDef := writedef; self.mInternal := ainternal; self.mAlias := xalias; + self.mTip := atip; + self.mHelp := ahelp; end; @@ -1255,7 +1398,7 @@ begin end; -procedure TDynField.writeBinTo (st: TStream); +procedure TDynField.writeBinTo (var hasLostData: Boolean; st: TStream); var s: AnsiString; f: Integer; @@ -1282,7 +1425,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 @@ -1396,16 +1539,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; @@ -1489,7 +1636,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; @@ -1540,6 +1687,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); @@ -1576,9 +1729,9 @@ begin rec := mOwner; // find trigger definition tfld := rec.trigTypeField(); - if (tfld = nil) then raise TDynRecException.CreateFmt('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mName]); + if (tfld = nil) then raise TDynRecException.CreateFmt('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mTypeName]); 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]); + if (rc = nil) then raise TDynRecException.CreateFmt('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mTypeName, tfld.mSVal]); rc := rc.clone(mOwner.mHeaderRec); rc.mHeaderRec := mOwner.mHeaderRec; // on error, it will be freed by memowner @@ -1722,6 +1875,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); @@ -1776,9 +1939,9 @@ begin rec := mOwner; // find trigger definition tfld := rec.trigTypeField(); - if (tfld = nil) then raise TDynParseException.CreateFmt(pr, 'triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName]); + if (tfld = nil) then raise TDynParseException.CreateFmt(pr, 'triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mTypeName]); 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]); + if (rc = nil) then raise TDynParseException.CreateFmt(pr, 'triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mTypeName, tfld.mSVal]); rc := rc.clone(mOwner.mHeaderRec); rc.mHeaderRec := mOwner.mHeaderRec; //writeln(rc.definition); @@ -1828,7 +1991,7 @@ begin mDefined := true; if mOwner.addRecordByType(mEBSTypeName, rc) then begin - raise TDynParseException.CreateFmt(pr, '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.mTypeName]); end; pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records exit; @@ -1954,12 +2117,35 @@ 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.expectTT(pr.TTSemi); + 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); @@ -1987,7 +2173,7 @@ constructor TDynRecord.Create (pr: TTextParser); begin if (pr = nil) then raise TDynParseException.Create(pr, 'cannot create record type without type definition'); mId := ''; - mName := ''; + mTypeName := ''; mSize := 0; mFields := TDynFieldList.Create(); {$IF DEFINED(XDYNREC_USE_FIELDHASH)} @@ -2005,7 +2191,7 @@ end; constructor TDynRecord.Create (); begin - mName := ''; + mTypeName := ''; mSize := 0; mFields := TDynFieldList.Create(); {$IF DEFINED(XDYNREC_USE_FIELDHASH)} @@ -2038,7 +2224,7 @@ begin mRec2Free.Free(); mRec2Free := nil; end; - mName := ''; + mTypeName := ''; for fld in mFields do fld.Free(); mFields.Free(); mFields := nil; @@ -2167,7 +2353,9 @@ begin result := TDynRecord.Create(); result.mOwner := mOwner; result.mId := mId; - result.mName := mName; + result.mTypeName := mTypeName; + result.mTip := mTip; + result.mHelp := mHelp; result.mSize := mSize; result.mHeader := mHeader; result.mBinBlock := mBinBlock; @@ -2278,7 +2466,7 @@ begin if not (fld.mEBSType is TDynEBS) then continue; es := (fld.mEBSType as TDynEBS); assert(es <> nil); - if StrEqu(es.mName, 'TriggerType') then begin result := fld; exit; end; + if StrEqu(es.mTypeName, 'TriggerType') then begin result := fld; exit; end; end; result := nil; end; @@ -2298,14 +2486,67 @@ end; function TDynRecord.newTypedRecord (const atypename, aid: AnsiString): TDynRecord; var trc: TDynRecord; + fld: TDynField; begin if not mHeader then raise TDynRecException.Create('cannot create new records with non-header'); + if (Length(aid) = 0) then raise TDynRecException.CreateFmt('cannot create new record of type ''%s'' without id', [atypename]); trc := mapdef.recType[atypename]; if (trc = nil) then begin result := nil; exit; end; + // check if aid is unique + fld := field[atypename]; + if (fld <> nil) and (fld.getListItem(aid) <> nil) then raise TDynRecException.CreateFmt('cannot create record of type ''%s'' with duplicate id ''%s''', [atypename, aid]); result := trc.clone(self); - result.mId := ''; // for now - addRecordByType(atypename, result); result.mId := aid; + addRecordByType(atypename, result); +end; + + +procedure TDynRecord.clearRefRecs (rec: TDynRecord); + procedure clearRefs (fld: TDynField); + var + rc: TDynRecord; + begin + if (fld = nil) then exit; + if (fld.mRecRef = rec) then fld.mRecRef := nil; + if (fld.mType = fld.TType.TList) then for rc in fld.mRVal do rc.clearRefRecs(rec); + end; +var + fld: TDynField; +begin + if (rec = nil) or (mFields = nil) then exit; + for fld in mFields do clearRefs(fld); +end; + + +// remove record with the given type and id +// return `true` if record was successfully found and removed +// this will do all necessary recref cleanup too +function TDynRecord.removeTypedRecord (const atypename, aid: AnsiString): Boolean; +var + trc, rec: TDynRecord; + fld: TDynField; + f: Integer; + doFree: Boolean = false; +begin + result := false; + if not mHeader then raise TDynRecException.Create('cannot remove records with non-header'); + if (Length(aid) = 0) then exit; + trc := mapdef.recType[atypename]; + if (trc = nil) then exit; + fld := field[atypename]; + if (fld = nil) then exit; + rec := fld.removeListItem(aid); + if (rec = nil) then exit; + clearRefRecs(rec); + for f := 0 to mRec2Free.count-1 do + begin + if (mRec2Free[f] = rec) then + begin + mRec2Free[f] := nil; + doFree := true; + end; + end; + if doFree then rec.Free(); end; @@ -2353,7 +2594,7 @@ begin while pr.eatTT(pr.TTComma) do begin end; if pr.eatDelim(')') then break; tdn := pr.expectId(); - if isForTrig[tdn] then raise TDynParseException.CreateFmt(pr, 'duplicate trigdata ''%s'' trigtype ''%s''', [mName, tdn]); + if isForTrig[tdn] then raise TDynParseException.CreateFmt(pr, 'duplicate trigdata ''%s'' trigtype ''%s''', [mTypeName, tdn]); SetLength(mTrigTypes, Length(mTrigTypes)+1); mTrigTypes[High(mTrigTypes)] := tdn; end; @@ -2364,27 +2605,39 @@ begin SetLength(mTrigTypes, 1); mTrigTypes[0] := tdn; end; - mName := 'TriggerData'; + mTypeName := 'TriggerData'; end else begin - mName := pr.expectStrOrId(); + mTypeName := pr.expectStrOrId(); while (pr.tokType <> pr.TTBegin) do begin if pr.eatId('header') then begin mHeader := true; continue; end; if pr.eatId('size') then begin - if (mSize > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `size` in record ''%s''', [mName]); + if (mSize > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `size` in record ''%s''', [mTypeName]); mSize := pr.expectInt(); - if (mSize < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' size: %d', [mName, mSize]); + if (mSize < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' size: %d', [mTypeName, mSize]); pr.expectId('bytes'); continue; end; if pr.eatId('binblock') then begin - if (mBinBlock >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `binblock` in record ''%s''', [mName]); + if (mBinBlock >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `binblock` in record ''%s''', [mTypeName]); mBinBlock := pr.expectInt(); - if (mBinBlock < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' binblock: %d', [mName, mBinBlock]); + 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; @@ -2434,7 +2687,7 @@ begin else begin // record - result := quoteStr(mName); + result := quoteStr(mTypeName); if (mSize >= 0) then result += Format(' size %d bytes', [mSize]); if mHeader then result += ' header'; end; @@ -2479,7 +2732,7 @@ 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.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId], MSG_WARNING); + 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); //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, ')'); @@ -2489,7 +2742,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; @@ -2533,7 +2786,7 @@ begin else begin // create list for this type - fld := TDynField.Create(rec.mName, TDynField.TType.TList); + fld := TDynField.Create(rec.mTypeName, TDynField.TType.TList); fld.mOwner := self; addField(fld); if (bsize > 0) then @@ -2546,7 +2799,7 @@ begin rec := rect.clone(self); rec.mHeaderRec := self; rec.parseBinValue(mst); - rec.mId := Format('%s%d', [rec.mName, f]); + rec.mId := Format('%s%d', [rec.mTypeName, f]); fld.addListItem(rec); //writeln('parsed ''', rec.mId, '''...'); end; @@ -2566,8 +2819,8 @@ begin end; // read fields - if StrEqu(mName, 'TriggerData') then mSize := Integer(st.size-st.position); - if (mSize < 1) then raise TDynRecException.CreateFmt('cannot read record of type ''%s'' with unknown size', [mName]); + if StrEqu(mTypeName, 'TriggerData') then mSize := Integer(st.size-st.position); + if (mSize < 1) then raise TDynRecException.CreateFmt('cannot read record of type ''%s'' with unknown size', [mTypeName]); GetMem(buf, mSize); st.ReadBuffer(buf^, mSize); for fld in mFields do @@ -2579,6 +2832,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); @@ -2586,14 +2845,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 @@ -2618,11 +2876,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 @@ -2672,7 +2934,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 @@ -2704,10 +2966,12 @@ procedure TDynRecord.writeTo (wr: TTextWriter; putHeader: Boolean=true); var fld: TDynField; rec: TDynRecord; + putTypeComment: Boolean; + f: Integer; begin if putHeader then begin - wr.put(mName); + wr.put(mTypeName); if (Length(mId) > 0) then begin wr.put(' '); wr.put(mId); end; wr.put(' '); end; @@ -2720,11 +2984,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; @@ -2798,7 +3082,7 @@ var 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 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]); + raise TDynParseException.CreateFmt(pr, '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]); end; //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')'); fld.mRecRefId := ''; @@ -2813,7 +3097,7 @@ var end; begin - if (mOwner = nil) then raise TDynParseException.CreateFmt(pr, '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', [mTypeName]); {$IF DEFINED(D2D_DYNREC_PROFILER)}stall := curTimeMicro();{$ENDIF} @@ -2852,7 +3136,7 @@ begin pr.skipToken(); rec.parseValue(pr); {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} - addRecordByType(rec.mName, rec); + addRecordByType(rec.mTypeName, rec); {$IF DEFINED(D2D_DYNREC_PROFILER)}profAddRecByType := curTimeMicro()-stt;{$ENDIF} continue; end; @@ -2867,8 +3151,8 @@ begin if (fld <> nil) then begin //writeln('2: <', mName, '.', pr.tokStr, '>'); - 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]); + if fld.defined then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in record ''%s''', [fld.mName, mTypeName]); + 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} @@ -2878,7 +3162,7 @@ begin end; // something is wrong - raise TDynParseException.CreateFmt(pr, 'unknown field ''%s'' in record ''%s''', [pr.tokStr, mName]); + raise TDynParseException.CreateFmt(pr, 'unknown field ''%s'' in record ''%s''', [pr.tokStr, mTypeName]); end; pr.expectTT(pr.TTEnd); @@ -2920,7 +3204,9 @@ end; procedure TDynEBS.cleanup (); begin mIsEnum := false; - mName := ''; + mTypeName := ''; + mTip := ''; + mHelp := ''; mIds := nil; mVals := nil; mMaxName := ''; @@ -2960,7 +3246,7 @@ var f, cv: Integer; begin if mIsEnum then result :='enum ' else result := 'bitset '; - result += mName; + result += mTypeName; result += ' {'#10; // fields if mIsEnum then cv := 0 else cv := 1; @@ -2990,7 +3276,7 @@ function TDynEBS.pasdef (): AnsiString; var f: Integer; begin - result := '// '+mName+#10'const'#10; + result := '// '+mTypeName+#10'const'#10; // fields for f := 0 to High(mIds) do begin @@ -3022,18 +3308,34 @@ begin if pr.eatId('enum') then mIsEnum := true else if pr.eatId('bitset') then mIsEnum := false else pr.expectId('enum'); - mName := pr.expectId(); + mTypeName := pr.expectId(); mMaxVal := Integer($80000000); if mIsEnum then cv := 0 else cv := 1; + while (pr.tokType <> pr.TTBegin) 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.expectTT(pr.TTBegin); while (pr.tokType <> pr.TTEnd) do begin idname := pr.expectId(); for f := 0 to High(mIds) do begin - if StrEqu(mIds[f], idname) then raise TDynParseException.CreateFmt(pr, '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, mTypeName]); end; - if StrEqu(mMaxName, idname) then raise TDynParseException.CreateFmt(pr, '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, mTypeName]); skipAdd := false; hasV := false; v := cv; @@ -3042,7 +3344,7 @@ begin begin if pr.eatId('MAX') then begin - if (Length(mMaxName) > 0) then raise TDynParseException.CreateFmt(pr, '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, mTypeName]); mMaxName := idname; skipAdd := true; end @@ -3311,11 +3613,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; @@ -3323,6 +3626,7 @@ begin begin if (sign[3] = #1) then begin + if (wasBinary <> nil) then wasBinary^ := true; result := parseBinMap(st); exit; end;