Complete BigTask

code/KaMGeneratedTerrainBridge.pas

@@ -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.

code/resource/KaMResourceInput.pas

@@ -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