From: Ketmar Dark Date: Thu, 7 Sep 2017 05:33:14 +0000 (+0300) Subject: xdynrec: TColor type (rgb, and optional a) X-Git-Url: http://deadsoftware.ru/gitweb?p=d2df-sdl.git;a=commitdiff_plain;h=44b1b8d4008737947a55103121e2a607a1927a88 xdynrec: TColor type (rgb, and optional a) --- diff --git a/src/game/g_game.pas b/src/game/g_game.pas index 73c8ddf..e02fbd6 100644 --- a/src/game/g_game.pas +++ b/src/game/g_game.pas @@ -96,8 +96,8 @@ procedure g_Game_RestartRound(NoMapRestart: Boolean = False); procedure g_Game_ClientWAD(NewWAD: String; WHash: TMD5Digest); procedure g_Game_SaveOptions(); function g_Game_StartMap(Map: String; Force: Boolean = False; const oldMapPath: AnsiString=''): Boolean; -procedure g_Game_ChangeMap(MapPath: String); -procedure g_Game_ExitLevel(Map: Char16); +procedure g_Game_ChangeMap(const MapPath: String); +procedure g_Game_ExitLevel(const Map: AnsiString); function g_Game_GetFirstMap(WAD: String): String; function g_Game_GetNextMap(): String; procedure g_Game_NextLevel(); @@ -4077,7 +4077,7 @@ begin g_Options_Write_Video(GameDir+'/'+CONFIG_FILENAME); end; -procedure g_Game_ChangeMap(MapPath: String); +procedure g_Game_ChangeMap(const MapPath: String); var Force: Boolean; begin @@ -4261,7 +4261,7 @@ begin MapList := nil; end; -procedure g_Game_ExitLevel(Map: Char16); +procedure g_Game_ExitLevel(const Map: AnsiString); begin gNextMap := Map; @@ -4496,7 +4496,7 @@ end; procedure g_Game_DeleteTestMap(); var a: Integer; - MapName: Char16; + //MapName: AnsiString; WadName: string; { WAD: TWADFile; @@ -4506,15 +4506,14 @@ var begin a := Pos('.wad:\', toLowerCase1251(gMapToDelete)); if (a = 0) then a := Pos('.wad:/', toLowerCase1251(gMapToDelete)); - if a = 0 then - Exit; + if (a = 0) then exit; -// Âûäåëÿåì èìÿ wad-ôàéëà è èìÿ êàðòû: - WadName := Copy(gMapToDelete, 1, a + 3); - Delete(gMapToDelete, 1, a + 5); + // Âûäåëÿåì èìÿ wad-ôàéëà è èìÿ êàðòû + WadName := Copy(gMapToDelete, 1, a+3); + Delete(gMapToDelete, 1, a+5); gMapToDelete := UpperCase(gMapToDelete); - MapName := ''; - CopyMemory(@MapName[0], @gMapToDelete[1], Min(16, Length(gMapToDelete))); + //MapName := ''; + //CopyMemory(@MapName[0], @gMapToDelete[1], Min(16, Length(gMapToDelete))); { // Èìÿ êàðòû íå ñòàíäàðòíîå òåñòîâîå: diff --git a/src/game/g_main.pas b/src/game/g_main.pas index da95b14..af83d89 100644 --- a/src/game/g_main.pas +++ b/src/game/g_main.pas @@ -250,7 +250,7 @@ label Cheated; var s, s2: string; - c: Char16; + c: ShortString; a: Integer; begin if (not gGameOn) or (not gCheats) or ((gGameSettings.GameType <> GT_SINGLE) and diff --git a/src/shared/MAPDEF.pas b/src/shared/MAPDEF.pas index 53bedb7..c636117 100644 --- a/src/shared/MAPDEF.pas +++ b/src/shared/MAPDEF.pas @@ -55,17 +55,30 @@ type function isValid (): Boolean; inline; end; - Char16 = packed array[0..15] of Char; - Char32 = packed array[0..31] of Char; - Char64 = packed array[0..63] of Char; - Char100 = packed array[0..99] of Char; - Char256 = packed array[0..255] of Char; - Byte128 = packed array[0..127] of Byte; + TDFColor = packed record + public + r, g, b, a: Byte; // a: 0 is transparent, 255 is opaque + + public + constructor Create (ar, ag, ab: LongInt; aa: LongInt=0); + + function isTransparent (): Boolean; inline; + function isOpaque (): Boolean; inline; + end; {$INCLUDE mapdef.inc} // various helpers to access map structures type + TDynFieldHelper = class helper for TDynField + public + function getRGBA (): TDFColor; inline; + procedure setRGBA (const v: TDFColor); inline; + + public + property rgba: TDFColor read getRGBA write setRGBA; // for `TColor` + end; + TDynRecordHelper = class helper for TDynRecord private function getFieldWithType (const aname: AnsiString; atype: TDynField.TType): TDynField; inline; @@ -178,6 +191,21 @@ constructor TDFSize.Create (aw, ah: LongInt); begin w := aw; h := ah; end; function TDFSize.isZero (): Boolean; inline; begin result := (w = 0) and (h = 0); end; function TDFSize.isValid (): Boolean; inline; begin result := (w > 0) and (h > 0); end; +constructor TDFColor.Create (ar, ag, ab: LongInt; aa: LongInt=0); +begin + if (ar < 0) then r := 0 else if (ar > 255) then r := 255 else r := Byte(ar); + if (ag < 0) then g := 0 else if (ag > 255) then g := 255 else g := Byte(ag); + if (ab < 0) then b := 0 else if (ab > 255) then b := 255 else b := Byte(ab); + if (aa < 0) then a := 0 else if (aa > 255) then a := 255 else a := Byte(aa); +end; +function TDFColor.isTransparent (): Boolean; inline; begin result := (a = 0); end; +function TDFColor.isOpaque (): Boolean; inline; begin result := (a = 255); end; + + +// ////////////////////////////////////////////////////////////////////////// // +function TDynFieldHelper.getRGBA (): TDFColor; inline; begin result := TDFColor.Create(red, green, blue, alpha); end; +procedure TDynFieldHelper.setRGBA (const v: TDFColor); inline; begin red := v.r; green := v.g; blue := v.b; alpha := v.a; end; + // ////////////////////////////////////////////////////////////////////////// // function TDynRecordHelper.getUserPanelId (): Integer; inline; diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index e562663..b65ab8a 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 @@ -76,6 +76,8 @@ type 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 @@ -94,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 @@ -162,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); @@ -184,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 @@ -620,6 +640,8 @@ begin mType := TType.TInt; mIVal := 0; mIVal2 := 0; + mIVal3 := 0; + mIVal4 := 0; // default alpha value mSVal := ''; mRVal.Free(); mRVal := nil; @@ -638,6 +660,8 @@ begin mDefSVal := ''; mDefIVal := 0; mDefIVal2 := 0; + mDefIVal3 := 0; + mDefIVal4 := 0; // default value for alpha mDefRecRef := nil; mEBS := TEBS.TNone; mEBSTypeName := ''; @@ -665,6 +689,8 @@ begin result.mType := mType; result.mIVal := mIVal; result.mIVal2 := mIVal2; + result.mIVal3 := mIVal3; + result.mIVal4 := mIVal4; result.mSVal := mSVal; if (mRVal <> nil) then begin @@ -688,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; @@ -762,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'); @@ -877,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 @@ -901,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 @@ -914,6 +958,8 @@ begin mDefSVal := ''; mDefIVal := 0; mDefIVal2 := 0; + mDefIVal3 := 0; + mDefIVal4 := 0; // default value for alpha mDefRecRef := nil; end else @@ -921,6 +967,8 @@ begin oSVal := mSVal; oIVal := mIVal; oIVal2 := mIVal2; + oIVal3 := mIVal3; + oIVal4 := mIVal4; oRRef := mRecRef; oDef := mDefined; try @@ -929,11 +977,15 @@ begin 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(); @@ -955,6 +1007,8 @@ begin mSVal := mDefSVal; mIVal := mDefIVal; mIVal2 := mDefIVal2; + mIVal3 := mDefIVal3; + mIVal4 := mDefIVal4; mDefined := true; end; @@ -967,6 +1021,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; @@ -1038,6 +1093,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'); @@ -1080,7 +1136,7 @@ var ainternal: Boolean; writedef: Boolean; defstr: AnsiString; - defint, defint2: Integer; + defint, defint2, defint3, defint4: Integer; hasdefStr: Boolean; hasdefInt: Boolean; hasdefId: Boolean; @@ -1104,6 +1160,8 @@ begin defstr := ''; defint := 0; defint2 := 0; + defint3 := 0; + defint4 := 0; hasdefStr := false; hasdefInt := false; hasdefId := false; @@ -1218,6 +1276,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 @@ -1262,6 +1325,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 @@ -1304,6 +1368,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; @@ -1472,6 +1537,16 @@ begin writeInt(st, Word(mIVal2)); exit; end; + TType.TColor: + begin + 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: @@ -1610,6 +1685,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); @@ -1792,6 +1873,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); @@ -2024,12 +2115,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);