This commit is contained in:
1 parent
e253946fc8
commit
3d5edaa086
7 files changed
+3014
-2
No files matched your search
@@ -0,0 +1,110 @@
|
||||
unit KaMGeneratedTerrainBridge;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
KM_ResTypes, KM_ResTilesetTypes;
|
||||
|
||||
type
|
||||
TKaMGeneratedTerrainInfoQuery = function(aTerrain: Integer): TKMGenTerrainInfo of object;
|
||||
TKaMGeneratedTerrainTransitionQuery = function(
|
||||
aTerKind: TKMTerrainKind;
|
||||
aMaskKind: TKMTileMaskKind;
|
||||
aMaskType: TKMTileMaskType;
|
||||
aMaskSubtype: TKMTileMaskSubType
|
||||
): Word of object;
|
||||
|
||||
function KaMGeneratedTerrainInfo(aTerrain: Integer): TKMGenTerrainInfo;
|
||||
function KaMGeneratedTerrainInfoLegacy(aTerrain: Integer): TKMGenTerrainInfo;
|
||||
function KaMGeneratedTerrainTransition(
|
||||
aTerKind: TKMTerrainKind;
|
||||
aMaskKind: TKMTileMaskKind;
|
||||
aMaskType: TKMTileMaskType;
|
||||
aMaskSubtype: TKMTileMaskSubType
|
||||
): Word;
|
||||
|
||||
procedure KaMPublishGeneratedTerrainProvider(
|
||||
aOwner: TObject;
|
||||
aCurrentInfo: TKaMGeneratedTerrainInfoQuery;
|
||||
aLegacyInfo: TKaMGeneratedTerrainInfoQuery;
|
||||
aTransition: TKaMGeneratedTerrainTransitionQuery
|
||||
);
|
||||
procedure KaMUnpublishGeneratedTerrainProvider(aOwner: TObject);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
var
|
||||
GProviderOwner: TObject;
|
||||
GCurrentInfoQuery: TKaMGeneratedTerrainInfoQuery;
|
||||
GLegacyInfoQuery: TKaMGeneratedTerrainInfoQuery;
|
||||
GTransitionQuery: TKaMGeneratedTerrainTransitionQuery;
|
||||
|
||||
procedure ClearGeneratedTerrainProvider;
|
||||
begin
|
||||
GProviderOwner := nil;
|
||||
GCurrentInfoQuery := nil;
|
||||
GLegacyInfoQuery := nil;
|
||||
GTransitionQuery := nil;
|
||||
end;
|
||||
|
||||
procedure RequireGeneratedTerrainProvider;
|
||||
begin
|
||||
if (GProviderOwner = nil)
|
||||
or not Assigned(GCurrentInfoQuery)
|
||||
or not Assigned(GLegacyInfoQuery)
|
||||
or not Assigned(GTransitionQuery) then
|
||||
raise Exception.Create('Generated-terrain provider is unavailable');
|
||||
end;
|
||||
|
||||
function KaMGeneratedTerrainInfo(aTerrain: Integer): TKMGenTerrainInfo;
|
||||
begin
|
||||
RequireGeneratedTerrainProvider;
|
||||
Result := GCurrentInfoQuery(aTerrain);
|
||||
end;
|
||||
|
||||
function KaMGeneratedTerrainInfoLegacy(aTerrain: Integer): TKMGenTerrainInfo;
|
||||
begin
|
||||
RequireGeneratedTerrainProvider;
|
||||
Result := GLegacyInfoQuery(aTerrain);
|
||||
end;
|
||||
|
||||
function KaMGeneratedTerrainTransition(
|
||||
aTerKind: TKMTerrainKind;
|
||||
aMaskKind: TKMTileMaskKind;
|
||||
aMaskType: TKMTileMaskType;
|
||||
aMaskSubtype: TKMTileMaskSubType
|
||||
): Word;
|
||||
begin
|
||||
RequireGeneratedTerrainProvider;
|
||||
Result := GTransitionQuery(aTerKind, aMaskKind, aMaskType, aMaskSubtype);
|
||||
end;
|
||||
|
||||
procedure KaMPublishGeneratedTerrainProvider(
|
||||
aOwner: TObject;
|
||||
aCurrentInfo: TKaMGeneratedTerrainInfoQuery;
|
||||
aLegacyInfo: TKaMGeneratedTerrainInfoQuery;
|
||||
aTransition: TKaMGeneratedTerrainTransitionQuery
|
||||
);
|
||||
begin
|
||||
if (aOwner = nil)
|
||||
or not Assigned(aCurrentInfo)
|
||||
or not Assigned(aLegacyInfo)
|
||||
or not Assigned(aTransition) then
|
||||
raise Exception.Create('Generated-terrain provider binding is incomplete');
|
||||
|
||||
GProviderOwner := aOwner;
|
||||
GCurrentInfoQuery := aCurrentInfo;
|
||||
GLegacyInfoQuery := aLegacyInfo;
|
||||
GTransitionQuery := aTransition;
|
||||
end;
|
||||
|
||||
procedure KaMUnpublishGeneratedTerrainProvider(aOwner: TObject);
|
||||
begin
|
||||
if (aOwner <> nil) and (aOwner = GProviderOwner) then
|
||||
ClearGeneratedTerrainProvider;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -7,12 +7,49 @@ uses
|
||||
|
||||
function KaMResourceExists(const aReference: string): Boolean;
|
||||
function KaMOpenResourceStream(const aReference: string): TStream;
|
||||
function KaMResolvePackagedResource(const aRelativeIdentity: string): string;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
CastleUriUtils, CastleDownload;
|
||||
|
||||
procedure ValidatePackagedRelativeIdentity(const aRelativeIdentity: string);
|
||||
var
|
||||
I, ComponentStart: Integer;
|
||||
begin
|
||||
if (aRelativeIdentity = '') or (aRelativeIdentity[1] = '/') then
|
||||
raise EDownloadError.Create('KaMResourceInput: invalid packaged resource identity');
|
||||
|
||||
ComponentStart := 1;
|
||||
for I := 1 to Length(aRelativeIdentity) do
|
||||
begin
|
||||
if (aRelativeIdentity[I] = '\') or (aRelativeIdentity[I] = ':')
|
||||
or (Ord(aRelativeIdentity[I]) < 32) then
|
||||
raise EDownloadError.Create('KaMResourceInput: invalid packaged resource identity');
|
||||
if aRelativeIdentity[I] = '/' then
|
||||
begin
|
||||
if (I = ComponentStart)
|
||||
or ((I = ComponentStart + 1) and (aRelativeIdentity[ComponentStart] = '.'))
|
||||
or ((I = ComponentStart + 2) and (aRelativeIdentity[ComponentStart] = '.')
|
||||
and (aRelativeIdentity[ComponentStart + 1] = '.')) then
|
||||
raise EDownloadError.Create('KaMResourceInput: invalid packaged resource identity');
|
||||
ComponentStart := I + 1;
|
||||
end;
|
||||
end;
|
||||
if (ComponentStart > Length(aRelativeIdentity))
|
||||
or ((Length(aRelativeIdentity) = ComponentStart) and (aRelativeIdentity[ComponentStart] = '.'))
|
||||
or ((Length(aRelativeIdentity) = ComponentStart + 1) and (aRelativeIdentity[ComponentStart] = '.')
|
||||
and (aRelativeIdentity[ComponentStart + 1] = '.')) then
|
||||
raise EDownloadError.Create('KaMResourceInput: invalid packaged resource identity');
|
||||
end;
|
||||
|
||||
function KaMResolvePackagedResource(const aRelativeIdentity: string): string;
|
||||
begin
|
||||
ValidatePackagedRelativeIdentity(aRelativeIdentity);
|
||||
Result := 'castle-data:/game/' + InternalUriEscape(aRelativeIdentity);
|
||||
end;
|
||||
|
||||
function ResourceProtocol(const aReference: string): string;
|
||||
begin
|
||||
if aReference = '' then
|
||||
|
||||
@@ -5,7 +5,10 @@
|
||||
"src/common/KM_CommonClasses.pas",
|
||||
"src/settings/KM_GameSettings.pas",
|
||||
"src/utils/io/KM_IoXML.pas",
|
||||
"src/utils/KromUtils.pas"
|
||||
"src/utils/KromUtils.pas",
|
||||
"src/utils/KM_Utils.pas",
|
||||
"src/terrain/KM_TerrainUtils.pas",
|
||||
"src/res/KM_ResSprites.pas"
|
||||
],
|
||||
"source_paths": [
|
||||
"code/resource"
|
||||
|
||||
@@ -1,6 +1,7 @@
|
||||
{
|
||||
"schema": "kam-runtime-resources/1",
|
||||
"entries": [
|
||||
{"kind": "file", "path": "Maps/CatchTheSnake/CatchTheSnake.map"}
|
||||
{"kind": "file", "path": "Maps/CatchTheSnake/CatchTheSnake.map"},
|
||||
{"kind": "file", "path": "data/Sprites/Tileset.rxx"}
|
||||
]
|
||||
}
|
||||
File diff suppressed because it is too large.
Load diff
@@ -0,0 +1,231 @@
|
||||
unit KM_TerrainUtils;
|
||||
{$I KaM_Remake.inc}
|
||||
interface
|
||||
uses
|
||||
KM_Defaults,
|
||||
KM_TerrainTypes,
|
||||
KM_CommonClasses;
|
||||
|
||||
|
||||
procedure WriteTileToStream(S: TKMemoryStream; const aTileBasic: TKMTerrainTileBasic; aTileOwner: TKMHandID; aGameSave: Boolean); overload;
|
||||
procedure WriteTileToStream(S: TKMemoryStream; const aTileBasic: TKMTerrainTileBasic; aTileOwner: TKMHandID; aGameSave: Boolean; var aMapDataSize: Cardinal); overload;
|
||||
procedure ReadTileFromStream(aStream: TKMemoryStream; var aTileBasic: TKMTerrainTileBasic; aGameRev: Integer = 0);
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
Classes,
|
||||
KaMGeneratedTerrainBridge,
|
||||
KM_HandTypes, KM_ResTypes, KM_ResTilesetTypes;
|
||||
|
||||
|
||||
procedure WriteTileToStream(S: TKMemoryStream; const aTileBasic: TKMTerrainTileBasic; aTileOwner: TKMHandID; aGameSave: Boolean);
|
||||
var
|
||||
mapDataSize: Cardinal;
|
||||
begin
|
||||
WriteTileToStream(S, aTileBasic, aTileOwner, aGameSave, mapDataSize);
|
||||
end;
|
||||
|
||||
|
||||
procedure WriteTileToStream(S: TKMemoryStream; const aTileBasic: TKMTerrainTileBasic; aTileOwner: TKMHandID;
|
||||
aGameSave: Boolean; var aMapDataSize: Cardinal);
|
||||
|
||||
function PackLayersCorners(const aTileBasic: TKMTerrainTileBasic): Byte;
|
||||
var
|
||||
I, L: Integer;
|
||||
layersCnt: Byte;
|
||||
begin
|
||||
Result := 0;
|
||||
//Layers corners are packed into 1 byte.
|
||||
//It contains info which layer 'owns' each corner
|
||||
//f.e. aCorners[0] contains layer number, which 'own' 0 corner.
|
||||
//0-layer means BaseLayer
|
||||
layersCnt := 0;
|
||||
for I := 3 downto 0 do // go from 3 to 0, as we pack 3 corner to the most left
|
||||
begin
|
||||
if aTileBasic.BaseLayer.Corner[I] then
|
||||
layersCnt := 0
|
||||
else
|
||||
for L := 0 to 2 do
|
||||
if aTileBasic.Layer[L].Corner[I] then
|
||||
begin
|
||||
layersCnt := L + 1;
|
||||
Break;
|
||||
end;
|
||||
if I < 3 then //do not shl for first corner
|
||||
Result := Result shl 2;
|
||||
Result := Result or layersCnt;
|
||||
end;
|
||||
end;
|
||||
|
||||
//Pack generated terrain id identification info into 2 bytes (Word)
|
||||
//6 bits are for terKind (supports up to 64 terKinds)
|
||||
//2 bits for mask subType (supports up to 4 mask subTypes)
|
||||
//4 bits for mask Kind (supports up to 16 mask kinds)
|
||||
//4 bits for mask Type (MType) (supports up to 16 mask types)
|
||||
function PackTerrainGenInfo(aGenInfo: TKMGenTerrainInfo): Word;
|
||||
begin
|
||||
Result := Byte(aGenInfo.TerKind) shl 10;
|
||||
Result := Result or (Byte(aGenInfo.Mask.SubType) shl 8);
|
||||
Result := Result or (Byte(aGenInfo.Mask.Kind) shl 4);
|
||||
Result := Result or Byte(aGenInfo.Mask.MType);
|
||||
end;
|
||||
|
||||
var
|
||||
L: Integer;
|
||||
genInfo: TKMGenTerrainInfo;
|
||||
overlay: TKMTileOverlay;
|
||||
begin
|
||||
S.Write(aTileBasic.BaseLayer.Terrain); //1
|
||||
//Map file stores terrain, not the fields placed over it, so save OldRotation rather than Rotation
|
||||
S.Write(aTileBasic.BaseLayer.Rotation); //3
|
||||
S.Write(aTileBasic.Height); //4
|
||||
S.Write(aTileBasic.Obj); //5
|
||||
S.Write(aTileBasic.IsCustom); //7
|
||||
|
||||
overlay := toNone;
|
||||
// Player roads (when tile owner is specified) should not be saved as an overlay, when save .map file
|
||||
// since player roads are set for each player in the dat file
|
||||
// but they should for a game save or if they are made as an neutral road (so just simple overlay in the map file)
|
||||
if aGameSave or (aTileOwner = HAND_NONE) then
|
||||
overlay := aTileBasic.TileOverlay;
|
||||
|
||||
S.Write(overlay, SizeOf(overlay)); //8
|
||||
S.Write(aTileBasic.LayersCnt); //9
|
||||
Inc(aMapDataSize, 9); // obligatory 9 bytes per tile
|
||||
if aTileBasic.LayersCnt > 0 then
|
||||
begin
|
||||
S.Write(PackLayersCorners(aTileBasic));
|
||||
S.Write(aTileBasic.BlendingLvl);
|
||||
Inc(aMapDataSize, 2);
|
||||
for L := 0 to aTileBasic.LayersCnt - 1 do
|
||||
begin
|
||||
//We could add more masks and terKinds in future, so we can't stick with generated terrainId,
|
||||
//but need to save/load its generation parameters (terKind/mask types etc)
|
||||
genInfo := KaMGeneratedTerrainInfo(aTileBasic.Layer[L].Terrain);
|
||||
S.Write(PackTerrainGenInfo(genInfo));
|
||||
S.Write(aTileBasic.Layer[L].Rotation);
|
||||
Inc(aMapDataSize, 3); // Terrain (2 bytes) + Rotation (1 byte)
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure ReadTileFromStream(aStream: TKMemoryStream; var aTileBasic: TKMTerrainTileBasic; aGameRev: Integer = 0);
|
||||
|
||||
//Unpack generated terrain id identification info from 2 bytes (Word)
|
||||
//6 bits are for terKind (supports up to 64 terKinds)
|
||||
//2 bits for mask subType (supports up to 4 mask subTypes)
|
||||
//4 bits for mask Kind (supports up to 16 mask kinds)
|
||||
//4 bits for mask Type (MType) (supports up to 16 mask types)
|
||||
function UnpackTerrainGenInfo(aPackedInfo: Word): TKMGenTerrainInfo;
|
||||
begin
|
||||
Result.TerKind := TKMTerrainKind((aPackedInfo shr 10) and 63);
|
||||
Result.Mask.SubType := TKMTileMaskSubType((aPackedInfo shr 8) and 3);
|
||||
Result.Mask.Kind := TKMTileMaskKind((aPackedInfo shr 4) and 15);
|
||||
Result.Mask.MType := TKMTileMaskType(aPackedInfo and 15);
|
||||
end;
|
||||
|
||||
var
|
||||
I: Integer;
|
||||
terrainB, objectB, rot, corners: Byte;
|
||||
layersCorners: array[0..3] of Byte;
|
||||
useKaMFormat: Boolean;
|
||||
terIdentInfo: Word;
|
||||
genInfo: TKMGenTerrainInfo;
|
||||
begin
|
||||
useKaMFormat := (aGameRev = 0);
|
||||
|
||||
if useKaMFormat then
|
||||
begin
|
||||
aStream.Read(terrainB); //1
|
||||
aTileBasic.BaseLayer.Terrain := terrainB;
|
||||
aStream.Seek(1, soFromCurrent);
|
||||
aStream.Read(aTileBasic.Height); //3
|
||||
aStream.Read(rot); //4
|
||||
aTileBasic.BaseLayer.Rotation := rot mod 4; //Some original KaM maps have Rot > 3, mod 4 gives right result
|
||||
aStream.Seek(1, soFromCurrent);
|
||||
aStream.Read(objectB); //6
|
||||
aTileBasic.Obj := objectB;
|
||||
aTileBasic.BaseLayer.SetAllCorners;
|
||||
aTileBasic.LayersCnt := 0;
|
||||
aTileBasic.IsCustom := False;
|
||||
aTileBasic.BlendingLvl := TERRAIN_DEF_BLENDING_LVL;
|
||||
aTileBasic.TileOverlay := toNone;
|
||||
end else begin
|
||||
aStream.Read(aTileBasic.BaseLayer.Terrain); //2
|
||||
aStream.Read(rot); //3
|
||||
aTileBasic.BaseLayer.Rotation := rot mod 4; //Some original KaM maps have Rot > 3, mod 4 gives right result
|
||||
aStream.Read(aTileBasic.Height); //4
|
||||
aStream.Read(aTileBasic.Obj); //5
|
||||
aStream.Read(aTileBasic.IsCustom); //7
|
||||
aTileBasic.BlendingLvl := TERRAIN_DEF_BLENDING_LVL; //Default value;
|
||||
|
||||
if aGameRev > 10968 then
|
||||
aStream.Read(aTileBasic.TileOverlay, SizeOf(aTileBasic.TileOverlay)) //8
|
||||
else
|
||||
aTileBasic.TileOverlay := toNone;
|
||||
|
||||
// Load all layers info
|
||||
// First get layers count
|
||||
aStream.Read(aTileBasic.LayersCnt); //9
|
||||
if aTileBasic.LayersCnt = 0 then // No need to save corners, if we have no layers on that tile
|
||||
aTileBasic.BaseLayer.SetAllCorners // Set all corners then
|
||||
else begin
|
||||
// if there are some layers, then load base layer corners first
|
||||
aStream.Read(corners);
|
||||
|
||||
//Layers corners are packed into 1 byte.
|
||||
//It contains info which layer 'owns' each corner
|
||||
//f.e. aCorners[0] contains layer number, which 'own' 0 corner.
|
||||
//0-layer means BaseLayer
|
||||
layersCorners[0] := corners and $3;
|
||||
layersCorners[1] := (corners shr 2) and $3;
|
||||
layersCorners[2] := (corners shr 4) and $3;
|
||||
layersCorners[3] := (corners shr 6) and $3;
|
||||
|
||||
if aGameRev > 10745 then //Blending option appeared only after r10745
|
||||
aStream.Read(aTileBasic.BlendingLvl)
|
||||
else
|
||||
aTileBasic.BlendingLvl := TERRAIN_DEF_BLENDING_LVL;
|
||||
|
||||
for I := 0 to aTileBasic.LayersCnt - 1 do
|
||||
begin
|
||||
if aGameRev <= 10745 then
|
||||
begin
|
||||
aStream.Read(aTileBasic.Layer[I].Terrain); //Old generated TerrainID
|
||||
//Get terrain generation info for pre 10745 maps
|
||||
genInfo := KaMGeneratedTerrainInfoLegacy(aTileBasic.Layer[I].Terrain);
|
||||
end
|
||||
else
|
||||
begin
|
||||
aStream.Read(terIdentInfo); //Read packed info
|
||||
genInfo := UnpackTerrainGenInfo(terIdentInfo);
|
||||
end;
|
||||
//Get current generated terrain id by identification info
|
||||
//We could add more masks and terKinds in future, so we can't stick with generated terrainId,
|
||||
//but need to save/load its generation parameters (terKind/mask types etc)
|
||||
aTileBasic.Layer[I].Terrain := KaMGeneratedTerrainTransition(genInfo.TerKind, genInfo.Mask.Kind,
|
||||
genInfo.Mask.MType, genInfo.Mask.SubType);
|
||||
aStream.Read(aTileBasic.Layer[I].Rotation);
|
||||
end;
|
||||
|
||||
aTileBasic.BaseLayer.ClearCorners;
|
||||
for I := 0 to 2 do
|
||||
aTileBasic.Layer[I].ClearCorners;
|
||||
|
||||
for I := 0 to 3 do
|
||||
case layersCorners[I] of
|
||||
0: aTileBasic.BaseLayer.Corner[I] := True;
|
||||
else
|
||||
aTileBasic.Layer[layersCorners[I]-1].Corner[I] := True;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if useKaMFormat then
|
||||
aStream.Seek(17, soFromCurrent);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,328 @@
|
||||
unit KM_Utils;
|
||||
{$I KaM_Remake.inc}
|
||||
interface
|
||||
uses
|
||||
{$IFDEF WDC} IOUtils, {$ENDIF}
|
||||
SysUtils, StrUtils, Classes,
|
||||
// Controls,
|
||||
KM_TerrainTypes,
|
||||
KM_Defaults, KM_CommonTypes, KM_CommonClasses, KM_Points,
|
||||
KM_ResTypes;
|
||||
|
||||
function KMPathLength(aNodeList: TKMPointList): Single;
|
||||
|
||||
function GetHintWHotkey(const aText: String; aKeyFunc: TKMKeyFunction): String; overload;
|
||||
function GetHintWHotkey(aTextId: Integer; const aHotkeyStr: String): String; overload;
|
||||
function GetHintWHotkey(aTextId: Integer; aKeyFunc: TKMKeyFunction): String; overload;
|
||||
|
||||
function RoundToTilePixel(aVal: Single): Single; inline; overload;
|
||||
function RoundToTilePixel(aVal: TKMPointF): TKMPointF; inline; overload;
|
||||
|
||||
procedure LoadMapHeader(aStream: TKMemoryStream; var aMapX: Integer; var aMapY: Integer); overload;
|
||||
procedure LoadMapHeader(aStream: TKMemoryStream; var aMapX: Integer; var aMapY: Integer; var aGameRev: Integer); overload;
|
||||
procedure LoadMapHeader(aStream: TKMemoryStream; var aMapX: Integer; var aMapY: Integer; var aGameRev: Integer; var aMapDataSize: Cardinal); overload;
|
||||
|
||||
function GetTerrainTileBasic(aTile: TKMTerrainTile): TKMTerrainTileBasic;
|
||||
|
||||
procedure IterateOverArea(const aStartCell: TKMPoint; aSize: Integer; aIsSquare: Boolean; aOnCell: TPointEventSimple; aAroundArea: Boolean = False);
|
||||
|
||||
function GetLocalizedFilePath(aPath: string; aLocale, aFallbackLocale, aExt: AnsiString): string;
|
||||
|
||||
function CompareTextLogical(A, B: UnicodeString): Integer;
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
Math, KM_ResTexts, KM_ResKeys;
|
||||
|
||||
|
||||
function RoundToTilePixel(aVal: Single): Single; inline;
|
||||
begin
|
||||
Result := Round(aVal * CELL_SIZE_PX) / CELL_SIZE_PX;
|
||||
end;
|
||||
|
||||
|
||||
function RoundToTilePixel(aVal: TKMPointF): TKMPointF; inline;
|
||||
begin
|
||||
Result.X := RoundToTilePixel(aVal.X);
|
||||
Result.Y := RoundToTilePixel(aVal.Y);
|
||||
end;
|
||||
|
||||
|
||||
function KMPathLength(aNodeList: TKMPointList): Single;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
for I := 1 to aNodeList.Count - 1 do
|
||||
Result := Result + KMLengthDiag(aNodeList[I-1], aNodeList[I]);
|
||||
end;
|
||||
|
||||
|
||||
procedure LoadMapHeader(aStream: TKMemoryStream; var aMapX: Integer; var aMapY: Integer);
|
||||
var
|
||||
GameRev: Integer;
|
||||
begin
|
||||
LoadMapHeader(aStream, aMapX, aMapY, GameRev);
|
||||
end;
|
||||
|
||||
|
||||
procedure LoadMapHeader(aStream: TKMemoryStream; var aMapX: Integer; var aMapY: Integer; var aGameRev: Integer);
|
||||
var
|
||||
MapDataSize: Cardinal;
|
||||
begin
|
||||
LoadMapHeader(aStream, aMapX, aMapY, aGameRev, MapDataSize);
|
||||
end;
|
||||
|
||||
|
||||
//@Rey: Should we change "var" to "out" here and above? It would be more semantically correct in these cases
|
||||
procedure LoadMapHeader(aStream: TKMemoryStream; var aMapX: Integer; var aMapY: Integer; var aGameRev: Integer; var aMapDataSize: Cardinal);
|
||||
var
|
||||
GameRevision: UnicodeString;
|
||||
GameRev: Integer;
|
||||
begin
|
||||
aStream.Read(aMapX); // Get map header to determine old (r6720 and earlier) or newer format
|
||||
|
||||
aGameRev := 0;
|
||||
if aMapX = 0 then // Means we have not a standart KaM format map, but our own KaM_Remake format
|
||||
begin
|
||||
aStream.ReadW(GameRevision);
|
||||
if TryStrToInt(Copy(GameRevision, 2, Length(GameRevision) - 1), GameRev) then
|
||||
aGameRev := GameRev
|
||||
else
|
||||
raise Exception.Create('Unexpected game revision in map header');
|
||||
|
||||
aStream.Read(aMapDataSize);
|
||||
aStream.Read(aMapX);
|
||||
end;
|
||||
|
||||
aStream.Read(aMapY);
|
||||
if not InRange(aMapX, 1, MAX_MAP_SIZE) or not InRange(aMapY, 1, MAX_MAP_SIZE) then
|
||||
raise Exception.Create(Format('Can''t open the map cos it has wrong dimensions: [%d:%d]', [aMapX, aMapY]));
|
||||
end;
|
||||
|
||||
|
||||
// Iterate over area. Using different rounding (Circle/Square).
|
||||
// aOnCell - invoke that procedure on every iteration
|
||||
// aAroundArea - do we also iterate over surrounding tiles?
|
||||
procedure IterateOverArea(const aStartCell: TKMPoint; aSize: Integer; aIsSquare: Boolean; aOnCell: TPointEventSimple; aAroundArea: Boolean = False);
|
||||
type
|
||||
TKMRoundingMode = (rOdd, rEven);
|
||||
|
||||
//Is point I;J inside iterating area
|
||||
function IsInside(I,J,Rad: Integer; aRounding: TKMRoundingMode): Boolean;
|
||||
begin
|
||||
case aRounding of
|
||||
rOdd: Result := aIsSquare or (Sqr(I) + Sqr(J) < Sqr(Rad+0.5));
|
||||
rEven: Result := aIsSquare or (Sqr(I+0.5)+Sqr(J+0.5) < Sqr(Rad));
|
||||
else Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
//Is Cell inside iterating area
|
||||
function IsCellInside(aCell: TKMPoint; Rad: Integer; aRounding: TKMRoundingMode): Boolean;
|
||||
var
|
||||
I,J: Integer;
|
||||
begin
|
||||
I := aCell.X - aStartCell.X;
|
||||
J := aCell.Y - aStartCell.Y;
|
||||
Result := InRange(I, -Rad, Rad-1) and InRange(J, -Rad, Rad-1) and IsInside(I, J, Rad, aRounding);
|
||||
end;
|
||||
|
||||
var
|
||||
BorderArea: TKMPointArray;
|
||||
K: Integer;
|
||||
|
||||
procedure ProceedCell(X,Y: Integer; aIsBorderCell: Boolean);
|
||||
begin
|
||||
aOnCell(X, Y);
|
||||
if aIsBorderCell and (Length(BorderArea) > K) then
|
||||
begin
|
||||
//Collect BorderArea cells
|
||||
BorderArea[K] := TKMPoint.New(X, Y);
|
||||
Inc(K);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
AroundArea: TStringList;
|
||||
I,J,MaxIJ,Rad,Size: Integer;
|
||||
PointsAround: TKMPointArray;
|
||||
P: TKMPoint;
|
||||
RoundingMode: TKMRoundingMode;
|
||||
FirstInRow, IsBorderCell: Boolean;
|
||||
begin
|
||||
K := 0;
|
||||
Size := aSize;
|
||||
if aAroundArea and (Size <> 0) then
|
||||
begin
|
||||
if aIsSquare then
|
||||
Inc(Size, 2)
|
||||
else
|
||||
SetLength(BorderArea, Max(1, 4*(Size - 1)));
|
||||
end;
|
||||
|
||||
if Size = 0 then
|
||||
begin
|
||||
// size smaller than one cell
|
||||
aOnCell(aStartCell.X, aStartCell.Y);
|
||||
if aAroundArea then
|
||||
begin
|
||||
aOnCell(aStartCell.X-1, aStartCell.Y-1);
|
||||
aOnCell(aStartCell.X-1, aStartCell.Y);
|
||||
aOnCell(aStartCell.X, aStartCell.Y-1);
|
||||
end;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Rad := Size div 2;
|
||||
// There are two brush types here, even and odd size
|
||||
if Size mod 2 = 1 then
|
||||
begin
|
||||
RoundingMode := rOdd;
|
||||
MaxIJ := Rad;
|
||||
end else
|
||||
begin
|
||||
RoundingMode := rEven;
|
||||
MaxIJ := Rad - 1;
|
||||
end;
|
||||
|
||||
for I := -Rad to MaxIJ do
|
||||
begin
|
||||
FirstInRow := True;
|
||||
for J := -Rad to MaxIJ do
|
||||
// Rounding corners in a nice way
|
||||
if IsInside(I,J,Rad,RoundingMode) then
|
||||
begin
|
||||
//Check if this tile is in 'border area'
|
||||
IsBorderCell := FirstInRow or (I = -Rad) or (I = MaxIJ) or (J = -Rad) or (J = MaxIJ) // check if its first or at edges
|
||||
or not IsInside(I,J+1,Rad,RoundingMode); // or if its last (next tile in row is not in area anymore)
|
||||
ProceedCell(aStartCell.X+J, aStartCell.Y+I, IsBorderCell);
|
||||
FirstInRow := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
if aAroundArea and not aIsSquare then
|
||||
begin
|
||||
AroundArea := TStringList.Create; //todo -cPractical: Replace with TKMPointList
|
||||
try
|
||||
AroundArea.Sort; //todo -cPractical: Sorting empty list, why? Or do we want added values to be sorted?
|
||||
AroundArea.Duplicates := dupIgnore;
|
||||
|
||||
for I := 0 to K - 1 do
|
||||
begin
|
||||
//Get around cells for border cells
|
||||
PointsAround := KMPointsAround(BorderArea[I]);
|
||||
for J := 0 to High(PointsAround) do
|
||||
// If border cell is outside of iterating area addthem to Around Area
|
||||
if not IsCellInside(PointsAround[J], Rad, RoundingMode) then
|
||||
AroundArea.Add(TypeToString(PointsAround[J]));
|
||||
end;
|
||||
|
||||
// Iterate through around area.
|
||||
// We assume, that iterating order is not important, so we do not care,
|
||||
// that first were iterated Central cells, then around area
|
||||
for I := 0 to AroundArea.Count - 1 do
|
||||
begin
|
||||
P := StringToType(AroundArea[I]);
|
||||
aOnCell(P.X, P.Y);
|
||||
end;
|
||||
finally
|
||||
AroundArea.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function GetTerrainTileBasic(aTile: TKMTerrainTile): TKMTerrainTileBasic;
|
||||
var
|
||||
L: Integer;
|
||||
begin
|
||||
Result.BaseLayer := aTile.BaseLayer;
|
||||
Result.LayersCnt := aTile.LayersCnt;
|
||||
Result.Height := aTile.Height;
|
||||
Result.Obj := aTile.Obj;
|
||||
Result.IsCustom := aTile.IsCustom;
|
||||
Result.BlendingLvl := aTile.BlendingLvl;
|
||||
Result.TileOverlay := aTile.TileOverlay;
|
||||
|
||||
for L := 0 to 2 do
|
||||
Result.Layer[L] := aTile.Layer[L];
|
||||
end;
|
||||
|
||||
|
||||
function GetHintWHotkey(const aText: String; aKeyFunc: TKMKeyFunction): String;
|
||||
var
|
||||
hotKeyStr: String;
|
||||
begin
|
||||
Result := aText;
|
||||
hotKeyStr := gResKeys.GetKeyNameById(aKeyFunc);
|
||||
if hotKeyStr <> '' then
|
||||
Result := Result + Format(' (''%s'')', [hotKeyStr]);
|
||||
end;
|
||||
|
||||
|
||||
function GetHintWHotkey(aTextId: Integer; const aHotkeyStr: String): String;
|
||||
var
|
||||
hotKeyStr: string;
|
||||
begin
|
||||
Result := gResTexts[aTextId];
|
||||
hotKeyStr := Trim(aHotkeyStr);
|
||||
if hotKeyStr <> '' then
|
||||
Result := Result + Format(' (''%s'')', [hotKeyStr]);
|
||||
end;
|
||||
|
||||
|
||||
function GetHintWHotkey(aTextId: Integer; aKeyFunc: TKMKeyFunction): String;
|
||||
begin
|
||||
Result := GetHintWHotkey(aTextId, gResKeys.GetKeyNameById(aKeyFunc));
|
||||
end;
|
||||
|
||||
|
||||
// Try to find path to file with local suffixes, f.e. TSK01.waterfall.eng.wav
|
||||
function GetLocalizedFilePath(aPath: string; aLocale, aFallbackLocale, aExt: AnsiString): string;
|
||||
begin
|
||||
Result := aPath + '.' + String(aLocale) + String(aExt); // Try to file with our locale first
|
||||
if FileExists(Result) then
|
||||
Exit
|
||||
else
|
||||
begin
|
||||
Result := aPath + '.' + String(aFallbackLocale) + String(aExt); // then with fallback locale
|
||||
if FileExists(Result) then
|
||||
Exit
|
||||
else
|
||||
begin
|
||||
Result := aPath + '.' + String(DEFAULT_LOCALE) + String(aExt); // then with default locale (eng)
|
||||
if FileExists(Result) then
|
||||
Exit
|
||||
else
|
||||
begin
|
||||
Result := aPath + String(aExt); // and finally without any locale
|
||||
if FileExists(Result) then
|
||||
Exit
|
||||
else
|
||||
Exit('');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{$IFDEF MSWindows}
|
||||
// Logical comparison of the string, as Windows do
|
||||
// taken from https://stackoverflow.com/questions/10108789/is-there-a-compare-function-for-file-name-sorting
|
||||
function StrCmpLogicalW(psz1, psz2: PWideChar): Integer; stdcall; external 'shlwapi.dll';
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
function CompareTextLogical(A, B: UnicodeString): Integer;
|
||||
begin
|
||||
{$IFDEF MSWindows}
|
||||
Result := StrCmpLogicalW(PWideChar(A), PWideChar(B));
|
||||
{$ELSE}
|
||||
Result := CompareText(A, B);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
Reference in new issue
Block a user