{
  Copyright 2007-2022 Michalis Kamburelis.

  This file is part of "Castle Game Engine".

  "Castle Game Engine" is free software; see the file COPYING.txt,
  included in this distribution, for details about the copyright.

  "Castle Game Engine" is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

  ----------------------------------------------------------------------------
}

{ Material and texture properties from external files (TMaterialProperty,
  global MaterialProperties collection). }
unit CastleMaterialProperties;

{$I castleconf.inc}

interface

uses Classes, DOM, Generics.Collections,
  CastleUtils, CastleClassUtils, {$ifndef CASTLE_STRICT_CLI} CastleSoundEngine, {$endif}
  CastleStringUtils, CastleImages, CastleFindFiles, CastleInternalAutoGenerated;

type
  { Information for a particular material. }
  TMaterialProperty = class
  strict private
    FTextureBaseName: String;
    {$ifndef CASTLE_STRICT_CLI}
    FFootstepsSound: TCastleSound;
    {$endif}
    FToxic: Boolean;
    FToxicDamageConst, FToxicDamageRandom, FToxicDamageTime: Single;
    FNormalMap: String;
    FAlphaChannel: String;
  private
    procedure LoadFromDOMElement(Element: TDOMElement; const BaseURL: String);
  public
    { Texture basename to associate this property will all appearances
      using given texture. For now, this is the only way to associate
      property, but more are possible in the future (like MaterialNodeName).

      @deprecated All properties affected by this filter are deprecated. }
    property TextureBaseName: String read FTextureBaseName write FTextureBaseName; {$ifdef FPC}deprecated;{$endif}

    {$ifndef CASTLE_STRICT_CLI}
    { Footsteps sound to make when player is walking on this material.
      nil if no information is available.

      @deprecated }
    property FootstepsSound: TCastleSound read FFootstepsSound write FFootstepsSound; {$ifdef FPC}deprecated;{$endif}
    {$endif}

    { Is the floor toxic when walking on it.
      Taken into account only if you assign @code(TLevel.Player).

      @deprecated Just like @code(TLevel.Player).
      @groupBegin }
    property Toxic: Boolean read FToxic write FToxic; {$ifdef FPC}deprecated;{$endif}
    property ToxicDamageConst: Single read FToxicDamageConst write FToxicDamageConst; {$ifdef FPC}deprecated;{$endif}
    property ToxicDamageRandom: Single read FToxicDamageRandom write FToxicDamageRandom; {$ifdef FPC}deprecated;{$endif}
    property ToxicDamageTime: Single read FToxicDamageTime write FToxicDamageTime; {$ifdef FPC}deprecated;{$endif}
    { @groupEnd }

    { Normal map texture URL. This is a simple method to activate bump mapping,
      equivalent to using normalMap field in an Appearance node of VRML/X3D, see
      https://castle-engine.io/x3d_extensions.php#section_ext_bump_mapping .

      In case both VRML/X3D Appearance specifies normalMap and we have
      NormalMap defined here, the VRML/X3D Appearance is used.

      @deprecated Normal maps can be specified comfortably in glTF, X3D, Blender files. }
    property NormalMap: String read FNormalMap write FNormalMap; {$ifdef FPC}deprecated;{$endif}

    { Override alpha channel type for diffuse texture.
      The meaning and allowed values for this are the same as for
      alphaChannel field for texture nodes, see
      https://castle-engine.io/x3d_extensions.php#section_ext_alpha_channel_detection .
      Empty value (default) doesn't change the alpha channel type
      (set in VRML/X3D or auto-detected).

      @deprecated Alpha can be specified comfortably in glTF, X3D, Blender files. }
    property AlphaChannel: String read FAlphaChannel write FAlphaChannel; {$ifdef FPC}deprecated;{$endif}
  end;

  TMaterialPropertyList = {$ifdef FPC}specialize{$endif} TObjectList<TMaterialProperty>;

  TCompressionsMap = {$ifdef FPC}specialize{$endif} TDictionary<TTextureCompression, TCastlePlatforms>;

  TTextureCompressionsToGenerate = class
    { Compressions.Keys are the compressed formats to generate.
      For each compression format, we also specify the platforms on
      which is should be distributed and used. }
    Compressions: TCompressionsMap;
    { In addition to Compressions.Keys,
      generate also the most suitable variant of DXTn compression. }
    DxtAutoDetect: Boolean;
    DxtAutoDetectPlatforms: TCastlePlatforms;
    constructor Create;
    destructor Destroy; override;
    { HasSomeCompression means that some compression is indicated
      (DxtAutoDetect is true, or Compressions are not empty). }
    //function HasSomeCompression: Boolean; // unused
  end;

  { How to scale texture. }
  TScale = record
    { The scale (as in ScaledWidth := Width / (2 ^ Scale.Value).
      Should be intepreted just like TextureLoadingScale.
      See https://castle-engine.io/creating_data_material_properties.php#section_texture_scale }
    Value: Byte;
    { List of platforms for which this scale should be packaged. }
    Platforms: TCastlePlatforms;
  end;
  TScalesList = {$ifdef FPC}specialize{$endif} TList<TScale>;

  TAutoGeneratedTextures = class
  strict private
    const
      PathsIgnoreCase = true;
    var
    FAutoProcessImageURLs: Boolean;
    IncludePaths: TCastleStringList; // absolute URLs
    IncludePathsRecursive: TBooleanList;
    ExcludePaths: TCastleStringList;
    { necessary for Exclude with relative dirs, like "entites/*", to work }
    FBaseURL: String;
    FCompressedFormatsToGenerate: TTextureCompressionsToGenerate;
    GatheringResult: TCastleStringList;
    FScales: TScalesList;
    FPreferredOutputFormat: String;
    FTrivialUncompressedConvert: Boolean;
    FMipmapsLevel: Cardinal;
    FAutoGeneratedAtLoad: TAutoGenerated;
    procedure GatherCallback(const FileInfo: TFileInfo; var StopSearch: Boolean);
    procedure LoadImageEvent(var URL: String);
    function IsAbsoluteURLMatchingRelativeMask(const URL, Mask: String): Boolean;
  private
    { Largest Scale.Value for this texture. }
    function LargestScaleValue: Byte;
    function TextureURLMatches(const URL: String): Boolean;
    function AutoGeneratedTextures: TCastleStringList;
    function CompressedFormatsGenerated: TCompressionsMap;
    property PreferredOutputFormat: String read FPreferredOutputFormat;
  public
    constructor Create(const Element: TDOMElement; const BaseURL: String;
      const AnAutoProcessImageURLs: Boolean; const AnAutoGeneratedAtLoad: TAutoGenerated);
    destructor Destroy; override;

    { For given texture (absolute) URL and compression and scaling,
      return the proper (absolute) URL of auto-compressed and auto-downscaled counterpart.
      Scaling is defined just like TextureLoadingScale. }
    function GeneratedTextureURL(const URL: String;
      const UseCompression: Boolean; const TextureCompression: TTextureCompression;
      const Scaling: Cardinal): String;

    { Automatic compression formats generated for this texture.
      May return @nil, if there are no compressed formats to generate for this texture.
      The resulting class instance cannot be modified, and it is owned by this TMaterialProperties
      instance, so don't free it yourself. }
    property CompressedFormatsToGenerate: TTextureCompressionsToGenerate
      read FCompressedFormatsToGenerate;

    { Determine the platforms for which the original texture should be packaged }
    function OriginalPlatforms: TCastlePlatforms;

    { Which scales to generate for this texture. Read-only. }
    property Scales: TScalesList read FScales;

    { Perform trivial conversion (that does not compress, does not downscale)
      for this texture. }
    property TrivialUncompressedConvert: Boolean read FTrivialUncompressedConvert;

    property MipmapsLevel: Cardinal read FMipmapsLevel;
  end;

  TAutoGeneratedTexturesList = {$ifdef FPC}specialize{$endif} TObjectList<TAutoGeneratedTextures>;

  { Store information that is naturally associated with a given material
    or texture in an external file. Documentation and example of such
    file is on  https://castle-engine.io/creating_data_material_properties.php .
    Right now this allows to define things like:

    @unorderedList(
      @itemSpacing compact
      @item footsteps,
      @item toxic ground (hurts player),
      @item bump mapping (normal maps and height maps for given texture),
      @item texture GPU-compressed and downscaled alternatives.
    )

    In the future, it should be possible to express all these properties
    in pure VRML/X3D (inside Appearance / Material / ImageTexture nodes).
    Right now, you can do this with bump mapping, see
    https://castle-engine.io/x3d_extensions.php#section_ext_bump_mapping ,
    but not footsteps or toxic ground.
    In the future it should also be possible to express these properties
    in 3D authoring software (like Blender), and easily export them
    to appropriate VRML/X3D nodes.
    For now, this TMaterialProperty allows us to easily customize materials
    in a way that is not possible in Blender.

    Using an external file for material properties has also long-term
    advantages: it can be shared across many 3D models, for example
    you can define footsteps sound for all grounds using the @code(grass.png)
    textures, in all levels, at once.

    You have to load an XML file by setting
    @link(TMaterialProperties.URL MaterialProperties.URL) property.
  }
  TMaterialProperties = class
  strict private
    FAutoGeneratedTexturesList: TAutoGeneratedTexturesList;
    FMaterialPropertyList: TMaterialPropertyList;
    FURL: String;
    FAutoProcessImageURLs: Boolean;
    { Information about available (already created) compressed/downscaled textures.
      Obtained from CastleAutoGenerated.xml at the moment of TMaterialProperties.Create
      (so, at application start in practice). }
    FAutoGeneratedAtLoad: TAutoGenerated;
    procedure SetURL(const Value: String);
  public
    constructor Create(const AnAutoProcessImageURLs: Boolean);
    destructor Destroy; override;

    { Load material properties from given XML file.
      Set this to empty string to unload previously loaded properties.
      See Castle1 and fps_game data for examples how this looks like,
      in @code(material_properties.xml). }
    property URL: String read FURL write SetURL;

    {$ifdef FPC}
    property FileName: String read FURL write SetURL; deprecated 'use URL';
    {$endif}

    { Find material properties for given texture basename.
      Returns @nil if no material properties are found
      (in particular, if @link(URL) was not set yet). }
    function FindTextureBaseName(const TextureBaseName: String): TMaterialProperty;

    { Get the URLs of all textures that should have automatically
      generated GPU-compressed and downscaled counterparts.
      Returns a list of absolute URLs.
      This actually searches on disk, right now, to find the texture list,
      applying the include/exclude rules specified in material_properties.xml file.

      This is to be used by "castle-engine auto-generate-textures"
      tool, or similar tools.

      The objects on this list refer to TAutoGeneratedTextures objects
      that define @italic(how) to process this texture.

      Caller is responsible for freeing the returned TCastleStringList list. }
    function AutoGeneratedTextures: TCastleStringList;
  end;

{ Material and texture properties, see @link(TMaterialProperties).
  Set the @link(TMaterialProperties.URL URL) property
  to load material properties from XML file. }
function MaterialProperties: TMaterialProperties;

var
  { Use the auto-generated alternative downscaled images.
    This allows to conserve both GPU memory and loading time
    by using a downscaled images versions.

    The subset of your images which are affected by this must be declared inside
    the material_properties.xml file, which is loaded to @link(MaterialProperties).
    And the image files must be prepared earlier by the build tool call
    @code("castle-engine auto-generate-textures").
    See the https://castle-engine.io/creating_data_material_properties.php#section_texture_scale .

    Each size (width, height, and (for 3D images) depth) is scaled
    by @code(1 / 2^(TextureLoadingScale-1)).
    So value = 1 means no scaling, value = 2 means that each size is 1/2
    (texture area is 1/4), value = 3 means that each size is 1/4 and so on.

    This mechanism will @italic(not)
    automatically downscale textures at runtime. If the downscaled texture version
    should exist, according to the material_properties.xml file,
    but it doesn't, then texture loading will simply fail.
    If you want to scale the texture at runtime, use the similar @link(GLTextureScale)
    instead.

    This mechanism is independent from GLTextureScale:

    @unorderedList(
      @item(Scaling indicated by GLTextureScale is performed at runtime,
        after loading. It happens @bold(after) the results of
        TextureLoadingScale have already been applied.)

      @item(The GLTextureScale works on a different subset of textures.

        For GLTextureScale, the usage of a texture determines if it's a GUI texture
        (which cannot be scaled) or not.
        So textures loaded through TDrawableImage, or declared as guiTexture in X3D,
        are not affected by GLTextureScale. All other textures are affected.
        It doesn't matter from where they are loaded -- so it affects also
        texture contents created by code, or downloaded from the Internet.

        In contrast, the TextureLoadingScale works (only) on all the images
        declared as having a downscaled version in material_properties.xml.
        It is not affected by how the texture will be used.)

      @item(The GLTextureScale works only on texture formats that can be scaled.
        In particular, it cannot scale textures compressed with a GPU compression
        (S3TC and such). It silently ignores them.

        In contrast, the TextureLoadingScale can cooperate with GPU-compressed textures,
        if you also compress them automatically using the material_properties.xml
        and the build tool call @code("castle-engine auto-generate-textures").
        The downscaled image versions are generated from original (uncompressed,
        unscaled) images, and are then compressed.)

      @item(The GLTextureScale scaling is usually of worse quality, since it's
        done at runtime.

        In contrast, the downscaled textures used by TextureLoadingScale
        are generated as a preprocessing step.
        The build tool @code("castle-engine auto-generate-textures") may use
        a slower but higher-quality scaling.)
    )
  }
  TextureLoadingScale: Cardinal = 1;

implementation

uses SysUtils, XMLRead, StrUtils, Math,
  CastleXMLUtils, CastleFilesUtils,
  CastleURIUtils, CastleDownload, CastleLog;

const
  MaxScale = 32;

{ TMaterialProperty --------------------------------------------------------- }

procedure TMaterialProperty.LoadFromDOMElement(Element: TDOMElement; const BaseURL: String);
var
  {$ifndef CASTLE_STRICT_CLI}
  FootstepsSoundName: String;
  {$endif}
  ToxicDamage: TDOMElement;
  I: TXMLElementIterator;
begin
  if not Element.AttributeString('texture_base_name', FTextureBaseName) then
    raise Exception.Create('<properties> element must have "texture_base_name" attribute');

  {$ifndef CASTLE_STRICT_CLI}
  FootstepsSoundName := '';
  if Element.AttributeString('footsteps_sound', FootstepsSoundName) and
     (FootstepsSoundName <> '') then
    FFootstepsSound := SoundEngine.SoundFromName(FootstepsSoundName)
  else
    FFootstepsSound := nil;
  {$endif}

  if Element.AttributeString('normal_map', FNormalMap) and (FNormalMap <> '') then
    FNormalMap := CombineURI(BaseURL, FNormalMap) else
    FNormalMap := '';

  if not Element.AttributeString('alpha_channel', FAlphaChannel) then
    FAlphaChannel := '';

  I := Element.ChildrenIterator;
  try
    while I.GetNext do
      if I.Current.TagName = 'toxic' then
      begin
        FToxic := true;
        ToxicDamage := I.Current.ChildElement('damage');
        if not ToxicDamage.AttributeSingle('const', FToxicDamageConst) then
          FToxicDamageConst := 0;
        if not ToxicDamage.AttributeSingle('random', FToxicDamageRandom) then
          FToxicDamageRandom := 0;
        if not ToxicDamage.AttributeSingle('time', FToxicDamageTime) then
          FToxicDamageTime := 0;
      end else
        raise Exception.CreateFmt('Unknown element inside <property>: "%s"',
          [I.Current.TagName]);
  finally FreeAndNil(I) end;
end;

{ TTextureCompressionsToGenerate ----------------------------------------------------------- }

constructor TTextureCompressionsToGenerate.Create;
begin
  inherited;
  Compressions := TCompressionsMap.Create;
end;

destructor TTextureCompressionsToGenerate.Destroy;
begin
  FreeAndNil(Compressions);
  inherited;
end;

// function TTextureCompressionsToGenerate.HasSomeCompression: Boolean;
// begin
//   Result := (Compressions.Count <> 0) or DxtAutoDetect;
// end;

{ TAutoGeneratedTextures ----------------------------------------------------- }

constructor TAutoGeneratedTextures.Create(
  const Element: TDOMElement; const BaseURL: String;
  const AnAutoProcessImageURLs: Boolean;
  const AnAutoGeneratedAtLoad: TAutoGenerated);

  function PlatformsOfTextureCompression(const Element: TDOMElement): TCastlePlatforms;
  var
    PlatformsElement: TDOMElement;
    I: TXMLElementIterator;
  begin
    PlatformsElement := Element.Child('platforms', false);
    if PlatformsElement <> nil then
    begin
      Result := [];
      I := PlatformsElement.ChildrenIterator('platform');
      try
        while I.GetNext do
          Include(Result, StrToPlatform(Trim(I.Current.TextData)));
      finally FreeAndNil(I) end;
    end else
      Result := AllPlatforms;
  end;

  function StrToScale(const AString: String): Cardinal;
  begin
    Result := StrToInt(AString);
    if Result < 1 then
      raise Exception.CreateFmt('Error reading scale value "%s", the scale must be >= 1.', [AString]);
    if Result > MaxScale then
      raise Exception.CreateFmt('Error reading scale value "%s", the scale must be <= %d.', [AString, MaxScale]);
  end;

var
  ChildElements: TXMLElementIterator;
  ChildElement, CompressElement, ScalesElement, PlatformsElement, PreferredOutputFormatElement, MipmapsElement: TDOMElement;
  TextureCompressionName: String;
  ASmallestScale: Cardinal;
  ScalesIterator, PlatformsIterator: TXMLElementIterator;
  Scale: TScale;
  I: Integer;
begin
  inherited Create;
  FScales := TScalesList.Create;
  FAutoProcessImageURLs := AnAutoProcessImageURLs;
  IncludePaths := TCastleStringList.Create;
  IncludePathsRecursive := TBooleanList.Create;
  ExcludePaths := TCastleStringList.Create;
  FCompressedFormatsToGenerate := TTextureCompressionsToGenerate.Create;
  FBaseURL := BaseURL;
  FAutoGeneratedAtLoad := AnAutoGeneratedAtLoad;

  { read from XML }

  ChildElements := Element.ChildrenIterator('include');
  try
    while ChildElements.GetNext do
    begin
      ChildElement := ChildElements.Current;
      IncludePaths.Add(ChildElement.AttributeURL('path', BaseURL));
      IncludePathsRecursive.Add(ChildElement.AttributeBooleanDef('recursive', false));
    end;
  finally FreeAndNil(ChildElements) end;

  ChildElements := Element.ChildrenIterator('exclude');
  try
    while ChildElements.GetNext do
    begin
      ChildElement := ChildElements.Current;
      ExcludePaths.Add(ChildElement.AttributeString('path'));
    end;
  finally FreeAndNil(ChildElements) end;

  // calculate FCompressedFormatsToGenerate
  CompressElement := Element.ChildElement('compress', false);
  if CompressElement <> nil then
  begin
    ChildElements := CompressElement.ChildrenIterator('format');
    try
      while ChildElements.GetNext do
      begin
        TextureCompressionName := ChildElements.Current.AttributeString('name');
        if LowerCase(TextureCompressionName) = 'dxt_autodetect' then
        begin
          FCompressedFormatsToGenerate.DxtAutoDetect := true;
          FCompressedFormatsToGenerate.DxtAutoDetectPlatforms := PlatformsOfTextureCompression(ChildElements.Current);
        end else
          FCompressedFormatsToGenerate.Compressions.Add(
            StringToTextureCompression(TextureCompressionName),
            PlatformsOfTextureCompression(ChildElements.Current)
          );
      end;
    finally FreeAndNil(ChildElements) end;
  end;

  ScalesElement := Element.ChildElement('scale', false);
  if ScalesElement <> nil then
  begin
    { Deprecated "scale" element }
    WriteLnWarning('AutoGeneratedTextures', 'MaterialProperties contains "scale" node which is deprecated, use "scales" instead and list all scales.');
    if ScalesElement.HasAttribute('smallest') then
    begin
      WriteLnWarning('AutoGeneratedTextures', 'MaterialProperties contains "smallest" attribute which is deprecated.');
      ASmallestScale := ScalesElement.AttributeCardinalDef('smallest', 1);
      if not Between(ASmallestScale, 1, MaxScale) then
        raise Exception.CreateFmt('Invalid scale smallest value "%d" (must be an integer number within 1..%d)', [ASmallestScale, MaxScale]);
      for I := 1 to ASmallestScale do
      begin
        Scale.Platforms := AllPlatforms;
        Scale.Value := I;
        FScales.Add(Scale);
      end;
    end;
  end;

  ScalesElement := Element.ChildElement('scales', false);
  if ScalesElement <> nil then
  begin
    ScalesIterator := ScalesElement.ChildrenIterator('scale');
    try
      while ScalesIterator.GetNext do
      begin
        Scale.Value := StrToScale(ScalesIterator.Current.AttributeString('value'));
        Scale.Platforms := AllPlatforms;

        PlatformsElement := ScalesIterator.Current.ChildElement('platforms', false);
        if PlatformsElement <> nil then
        begin
          Scale.Platforms := [];
          PlatformsIterator := PlatformsElement.ChildrenIterator('platform');
          try
            while PlatformsIterator.GetNext do
              Include(Scale.Platforms, StrToPlatform(Trim(PlatformsIterator.Current.TextData)));
          finally
            FreeAndNil(PlatformsIterator);
          end;
        end;

        FScales.Add(Scale);
      end;
    finally
      FreeAndNil(ScalesIterator);
    end;
  end;

  // no <scale> or <scales> in material_properties.xml file -> do not downscale
  if FScales.Count = 0 then
  begin
    Scale.Value := 1;
    Scale.Platforms := AllPlatforms;
    FScales.Add(Scale);
  end;

  PreferredOutputFormatElement := Element.ChildElement('preferred_output_format', false);
  if PreferredOutputFormatElement <> nil then
    FPreferredOutputFormat := PreferredOutputFormatElement.AttributeStringDef('extension', '')
  else
    FPreferredOutputFormat := '.png';

  FTrivialUncompressedConvert := Element.ChildElement('trivial_uncompressed_convert', false) <> nil;

  MipmapsElement := Element.ChildElement('mipmaps', false);
  if MipmapsElement <> nil then
  begin
    FMipmapsLevel := MipmapsElement.AttributeCardinalDef('level', 0);
    { Mipmaps level = 0 and 1 are equivalent.
      Make it easier and just always express them as 0 in rest of API. }
    if FMipmapsLevel = 1 then
      FMipmapsLevel := 0;
  end else
    FMipmapsLevel := 0;

  if FAutoProcessImageURLs then
    AddLoadImageListener({$ifdef FPC}@{$endif} LoadImageEvent);
end;

function TAutoGeneratedTextures.CompressedFormatsGenerated: TCompressionsMap;
begin
  { TODO: for now, the DxtAutoDetect texture will not be used at all.
    The actual value of CompressedFormatsGenerated
    should come from auto_generated.xml. }
  Result := FCompressedFormatsToGenerate.Compressions;
end;

destructor TAutoGeneratedTextures.Destroy;
begin
  FreeAndNil(FScales);
  FreeAndNil(IncludePaths);
  FreeAndNil(IncludePathsRecursive);
  FreeAndNil(ExcludePaths);
  FreeAndNil(FCompressedFormatsToGenerate);
  if FAutoProcessImageURLs then
    RemoveLoadImageListener({$ifdef FPC}@{$endif} LoadImageEvent);
  inherited;
end;

function TAutoGeneratedTextures.LargestScaleValue: Byte;
var
  Scale: TScale;
begin
  Result := 1;
  for Scale in FScales do
    if Scale.Value > Result then
      Result := Scale.Value;
end;

procedure TAutoGeneratedTextures.GatherCallback(const FileInfo: TFileInfo; var StopSearch: Boolean);
begin
  if (Pos('/' + TAutoGenerated.AutoGeneratedDirName + '/', FileInfo.URL) = 0) and
     IsImageMimeType(URIMimeType(FileInfo.URL), false, false) then
    GatheringResult.Add(FileInfo.URL);
end;

function TAutoGeneratedTextures.IsAbsoluteURLMatchingRelativeMask(
  const URL, Mask: String): Boolean;
var
  U: String;
begin
  U := PrefixRemove(ExtractURIPath(FBaseURL), URL, PathsIgnoreCase);
  Result := IsWild(U, Mask, PathsIgnoreCase);
end;

function TAutoGeneratedTextures.
  AutoGeneratedTextures: TCastleStringList;

  procedure Exclude(const ExcludePathMask: String; const URLs: TCastleStringList);
  var
    I: Integer;
  begin
    I := 0;
    while I < URLs.Count do
    begin
      // Writeln('Excluding ExcludePathMask ' + ExcludePathMask +
      //   ' from ' + PrefixRemove(ExtractURIPath(FBaseURL), URLs[I], PathsIgnoreCase));
      if IsAbsoluteURLMatchingRelativeMask(URLs[I], ExcludePathMask) then
        URLs.Delete(I) else
        Inc(I);
    end;
  end;

var
  I: Integer;
  FindOptions: TFindFilesOptions;
begin
  Result := TCastleStringList.Create;
  GatheringResult := Result;

  for I := 0 to IncludePaths.Count - 1 do
  begin
    if IncludePathsRecursive[I] then
      FindOptions := [ffRecursive] else
      { not recursive, so that e.g. <include path="my_texture.png" />
        or <include path="subdir/my_texture.png" />
        should not include *all* my_texture.png files inside. }
      FindOptions := [];
    FindFiles(IncludePaths[I], false, {$ifdef FPC}@{$endif} GatherCallback, FindOptions);
  end;

  GatheringResult := nil;

  for I := 0 to ExcludePaths.Count - 1 do
    Exclude(ExcludePaths[I], Result);
end;

function TAutoGeneratedTextures.TextureURLMatches(const URL: String): Boolean;

  { Check is URL not excluded. }
  function CheckNotExcluded: Boolean;
  var
    I: Integer;
  begin
    for I := 0 to ExcludePaths.Count - 1 do
      if IsAbsoluteURLMatchingRelativeMask(URL, ExcludePaths[I]) then
        Exit(false);
    Result := true;
  end;

var
  URLName, URLPath: String;
  I: Integer;
  IncludePath, IncludeMask: String;
  PathMatches: Boolean;
begin
  Result := false;
  URLPath := ExtractURIPath(URL);
  URLName := ExtractURIName(URL);
  for I := 0 to IncludePaths.Count - 1 do
  begin
    IncludePath := ExtractURIPath(IncludePaths[I]);
    IncludeMask := ExtractURIName(IncludePaths[I]);
    if IncludePathsRecursive[I] then
      PathMatches := IsPrefix(IncludePath, URLPath, PathsIgnoreCase) else
      PathMatches := AnsiSameText(IncludePath, URLPath); { assume PathsIgnoreCase=true }
    if PathMatches and IsWild(URLName, IncludeMask, PathsIgnoreCase) then
    begin
      Result := CheckNotExcluded;
      Exit;
    end;
  end;
end;

procedure TAutoGeneratedTextures.LoadImageEvent(
  var URL: String);

  { Returns @true if the texture has square size.
    @false otherwise.
    If it's unknown, returns @false too.

    This uses CastleAutoGenerated.xml information to work without any file reading.
    If the Url is in our data, and it is in CastleAutoGenerated.xml,
    then we check it's size according to CastleAutoGenerated.xml. }
  function IsSquareTexture(const Url: String): Boolean;
  var
    Texture: TAutoGenerated.TTexture;
    WasInsideData: Boolean;
    UrlInData: String;
  begin
    UrlInData := RelativeToCastleDataURL(Url, WasInsideData);
    if not WasInsideData then
      Exit(false);
    Texture := FAutoGeneratedAtLoad.Texture(UrlInData, [], false);
    Result := (Texture <> nil) and (Texture.Width = Texture.Height);
  end;

  { Texture has GPU-compressed and/or downscaled counterpart, according to include/exclude
    variables. So try to replace URL with something compressed and downscaled. }
  procedure ReplaceURL;
  var
    C: TTextureCompression;
    Scale: Cardinal;
    CompressionPair: {$ifdef FPC}TCompressionsMap.TDictionaryPair{$else}
      TPair<TTextureCompression, TCastlePlatforms>{$endif};
  begin
    { Do not warn about it, just as we don't warn when TextureLoadingScale = 2
      but we're loading image not mentioned in <auto_generated_textures>.
    if TextureLoadingScale > SmallestScale then
      raise Exception.CreateFmt('Invalid TextureLoadingScale %d, we do not have such downscaled images. You should add or modify the <scale smallest=".." /> declaration in "material_properties.xml", and make sure thar you load the "material_properties.xml" early enough.',
        [TextureLoadingScale]); }
    Scale := Min(LargestScaleValue, TextureLoadingScale);

    if not SupportedTextureCompressionKnown then
      WritelnWarning('MaterialProperties', 'Cannot determine whether to use auto-generated (GPU compressed and/or downscaled) texture version for ' + URL + ' because the image is loaded before GPU capabilities are known')
    else
    begin
      {$ifdef CASTLE_IOS}
      if not IsSquareTexture(URL) then
      begin
        WritelnWarning('MaterialProperties', 'Not using GPU compressed (and potentially downscaled) version for ' + URL + ' because on iOS non-square compressed textures are not supported');
      end else
      {$endif}
      for CompressionPair in CompressedFormatsGenerated do
      begin
        C := CompressionPair.Key;
        if (C in SupportedTextureCompression) and (Platform in CompressionPair.Value) then
        begin
          URL := GeneratedTextureURL(URL, true, C, Scale);
          WritelnLog('MaterialProperties', 'Using GPU compressed (and potentially downscaled) alternative ' + URL);
          Exit;
        end;
      end;
    end;

    { no GPU compression supported; still, maybe we should use a downscaled alternative }
    if (Scale <> 1) or TrivialUncompressedConvert then
    begin
      URL := GeneratedTextureURL(URL, false, Low(TTextureCompression), Scale);
      WritelnLog('MaterialProperties', 'Using alternative ' + URL);
    end;
  end;

begin
  if TextureURLMatches(URL) then
    ReplaceURL;
end;

function TAutoGeneratedTextures.GeneratedTextureURL(
  const URL: String;
  const UseCompression: Boolean; const TextureCompression: TTextureCompression;
  const Scaling: Cardinal): String;
begin
  Result := ExtractURIPath(URL) + TAutoGenerated.AutoGeneratedDirName + '/';
  if UseCompression then
    Result := Result + LowerCase(TextureCompressionToString(TextureCompression)) + '/'
  else
    Result := Result + 'uncompressed/';
  if Scaling <> 1 then
    Result := Result + 'downscaled_' + IntToStr(Scaling) + '/';
  Result := Result + ExtractURIName(URL);
  if UseCompression then
    Result := Result + TextureCompressionInfo[TextureCompression].FileExtension
  else
    Result := Result + PreferredOutputFormat;
end;

function TAutoGeneratedTextures.OriginalPlatforms: TCastlePlatforms;
var
  Scale: TScale;
begin
  Result := [];
  for Scale in Scales do
    if Scale.Value = 1 then
      Result := Result + Scale.Platforms;
end;

{ TMaterialProperties ---------------------------------------------------------- }

constructor TMaterialProperties.Create(const AnAutoProcessImageURLs: Boolean);
begin
  inherited Create;
  FAutoProcessImageURLs := AnAutoProcessImageURLs;
  FMaterialPropertyList := TMaterialPropertyList.Create({ owns objects } true);
  FAutoGeneratedTexturesList := TAutoGeneratedTexturesList.Create({ owns objects } true);

  FAutoGeneratedAtLoad := TAutoGenerated.Create;
  FAutoGeneratedAtLoad.LoadFromFile('castle-data:/CastleAutoGenerated.xml');
end;

destructor TMaterialProperties.Destroy;
begin
  FreeAndNil(FAutoGeneratedAtLoad);
  FreeAndNil(FAutoGeneratedTexturesList);
  FreeAndNil(FMaterialPropertyList);
  inherited;
end;

procedure TMaterialProperties.SetURL(const Value: String);
var
  Config: TXMLDocument;
  Elements: TXMLElementIterator;
  MaterialProperty: TMaterialProperty;
  Stream: TStream;
begin
  FURL := Value;

  FMaterialPropertyList.Clear;
  FAutoGeneratedTexturesList.Clear;

  if URL = '' then Exit;

  Stream := Download(URL);
  try
    ReadXMLFile(Config, Stream, URL);
  finally FreeAndNil(Stream) end;

  try
    Check(Config.DocumentElement.TagName = 'properties',
      'Root node of material properties file must be <properties>');

    Elements := Config.DocumentElement.ChildrenIterator('property');
    try
      while Elements.GetNext do
      begin
        MaterialProperty := TMaterialProperty.Create;
        FMaterialPropertyList.Add(MaterialProperty);
        MaterialProperty.LoadFromDOMElement(Elements.Current, AbsoluteURI(URL));
      end;
    finally FreeAndNil(Elements); end;

    Elements := Config.DocumentElement.ChildrenIterator('auto_generated_textures');
    try
      while Elements.GetNext do
      begin
        FAutoGeneratedTexturesList.Add(
          TAutoGeneratedTextures.Create(Elements.Current, URL, FAutoProcessImageURLs,
            FAutoGeneratedAtLoad));
      end;
    finally FreeAndNil(Elements); end;
  finally
    SysUtils.FreeAndNil(Config);
  end;
end;

function TMaterialProperties.FindTextureBaseName(const TextureBaseName: String): TMaterialProperty;
var
  I: Integer;
begin
  {$warnings off} // using deprecated material props to keep them working
  for I := 0 to FMaterialPropertyList.Count - 1 do
    if SameText(FMaterialPropertyList[I].TextureBaseName, TextureBaseName) then
      Exit(FMaterialPropertyList[I]);
  {$warnings on}
  Result := nil;
end;

function TMaterialProperties.AutoGeneratedTextures: TCastleStringList;
var
  S: TCastleStringList;
  I, J: Integer;
begin
  Result := TCastleStringList.Create;
  try
    for I := 0 to FAutoGeneratedTexturesList.Count - 1 do
    begin
      S := FAutoGeneratedTexturesList[I].AutoGeneratedTextures;
      try
        for J := 0 to S.Count - 1 do
        begin
          if Result.IndexOf(S[J]) <> -1 then
            WritelnWarning('MaterialProperties', Format('The texture URL "%s" is under the influence of more than one <auto_generated_textures> rule. Use <include> and <exclude> to avoid it',
              [S[J]]))
          else
            Result.AddObject(S[J], FAutoGeneratedTexturesList[I]);
        end;
      finally FreeAndNil(S) end;
    end;
  except FreeAndNil(Result); raise end;
end;

{ globals -------------------------------------------------------------------- }

var
  FMaterialProperties: TMaterialProperties;

function MaterialProperties: TMaterialProperties;
begin
  if FMaterialProperties = nil then
    FMaterialProperties := TMaterialProperties.Create(true);
  Result := FMaterialProperties;
end;

initialization // empty but needed by delphi

finalization
  FreeAndNil(FMaterialProperties);
end.
