GLScene/Sourcex/GXS.Texture.pas

//
// The graphics engine GXScene https://github.com/glscene
//
unit GXS.Texture;

(* Handles all the color and texture stuff *)

interface

{$I GLScene.Defines.inc}

uses
  Winapi.OpenGL,
  Winapi.OpenGLext,
  System.Classes,
  System.SysUtils,
  System.Types,
  FMX.Graphics,
  FMX.Objects,

  GXS.TextureFormat,
  GLScene.Strings,

  GXS.XOpenGL,
  GLScene.VectorTypes,
  GLScene.VectorGeometry,
  GXS.BaseClasses,
  GXS.ApplicationFileIO,

  GXS.Graphics,
  GXS.Context,
  GXS.State,
  GXS.PipelineTransformation,
  GXS.Color,
  GXS.Coordinates,
  GXS.RenderContextInfo,
  GXS.ImageUtils,
  GLScene.Utils;

const
  cDefaultNormalMapScale = 0.125;

  CmtPX = 0;
  CmtNX = 1;
  CmtPY = 2;
  CmtNY = 3;
  CmtPZ = 4;
  CmtNZ = 5;

type
  TgxTextureMode = (tmDecal, tmModulate, tmBlend, tmReplace, tmAdd);
  TgxTextureWrap = (twBoth, twNone, twVertical, twHorizontal, twSeparate);

  TgxMinFilter =
  (
    miNearest,
    miLinear,
    miNearestMipmapNearest,
    miLinearMipmapNearest,
    miNearestMipmapLinear,
    miLinearMipmapLinear
  );

  TgxMagFilter = (maNearest, maLinear);

  (* Specifies how depth values should be treated
     during filtering and texture application *)
  TgxDepthTextureMode = (dtmLuminance, dtmIntensity, dtmAlpha);

  // Specifies the depth comparison function.
  TgxDepthCompareFunc = TgxDepthFunction;

  (* Texture format for OpenGL (rendering) use.
  Internally, GLXScene handles all "base" images as 32 Bits RGBA, but you can
  specify a generic format to reduce OpenGL texture memory use: *)
  TgxTextureFormat = (
    tfDefault,
    tfRGB, // = tfRGB8
    tfRGBA, // = tfRGBA8
    tfRGB16, // = tfRGB5
    tfRGBA16, // = tfRGBA4
    tfAlpha, // = tfALPHA8
    tfLuminance, // = tfLUMINANCE8
    tfLuminanceAlpha, // = tfLUMINANCE8_ALPHA8
    tfIntensity, // = tfINTENSITY8
    tfNormalMap, // = tfRGB8
    tfRGBAFloat16, // = tfRGBA_FLOAT16_ATI
    tfRGBAFloat32, // = tfRGBA_FLOAT32_ATI
    tfExtended);

  TgxTextureCompression = TglInternalCompression;

  TgxTexture = class;

  IgxTextureNotifyAble = interface(IgxNotifyAble)
    ['{0D9DC0B0-ECE4-4513-A8A1-5AE7022C9426}']
    procedure NotifyTexMapChange(Sender: TObject);
  end;

  TgxTextureNeededEvent = procedure(Sender: TObject; var TextureFileName: string)
    of object;

  TgxTextureChange = (tcImage, tcParams);
  TgxTextureChanges = set of TgxTextureChange;

  (*Defines how and if Alpha channel is defined for a texture image.
    tiaDefault : uses the alpha channel in the image if any
    tiaAlphaFromIntensity : the alpha channel value is deduced from other
    RGB components intensity (the brighter, the more opaque)
    tiaSuperBlackTransparent : pixels with a RGB color of (0, 0, 0) are
    completely transparent, others are completely opaque
    tiaLuminance : the luminance value is calculated for each pixel
    and used for RGB and Alpha values
    tiaLuminanceSqrt : same as tiaLuminance but with an Sqrt(Luminance)
    tiaOpaque : alpha channel is uniformously set to 1.0
    tiaTopLeftPointColorTransparent : points of the same color as the
    top left point of the bitmap are transparent, others are opaque. *)
  TgxTextureImageAlpha =
  (
    tiaDefault,
    tiaAlphaFromIntensity,
    tiaSuperBlackTransparent,
    tiaLuminance,
    tiaLuminanceSqrt,
    tiaOpaque,
    tiaTopLeftPointColorTransparent,
    tiaInverseLuminance,
    tiaInverseLuminanceSqrt,
    tiaBottomRightPointColorTransparent
  );

  (*Base class for texture image data.
   Basicly, subclasses are to be considered as different ways of getting
   a HBitmap (interfacing the actual source).
   SubClasses should be registered using RegisterTextureImageClass to allow
   proper persistence and editability in the IDE experts. *)
  TgxTextureImage = class(TgxUpdateAbleObject)
  private
    function GetResourceName: string;
  protected
    FOwnerTexture: TgxTexture;
    FOnTextureNeeded: TgxTextureNeededEvent;
    FResourceFile: string;
    class function IsSelfLoading: Boolean; virtual;
    procedure LoadTexture(AInternalFormat: TglInternalFormat); virtual;
    function GetTextureTarget: TglTextureTarget; virtual;
    function GetHeight: Integer; virtual;
    function GetWidth: Integer; virtual;
    function GetDepth: Integer; virtual;
    property OnTextureNeeded: TgxTextureNeededEvent read FOnTextureNeeded write FOnTextureNeeded;
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    property OwnerTexture: TgxTexture read FOwnerTexture write FOwnerTexture;
    procedure NotifyChange(Sender: TObject); override;
    (*Save textureImage to file.
     This may not save a picture, but for instance, parameters, if the
     textureImage is a procedural texture. *)
    procedure SaveToFile(const fileName: string); virtual;
    (*Load textureImage from a file.
     This may not load a picture, but for instance, parameters, if the
     textureImage is a procedural texture.
     Subclasses should invoke inherited which will take care of the
     "OnTextureNeeded" stuff. *)
    procedure LoadFromFile(const fileName: string); virtual;
    (*Returns a user-friendly denomination for the class.
     This denomination is used for picking a texture image class
     in the IDE expert. *)
    class function FriendlyName: string; virtual;
    (*Returns a user-friendly description for the class.
     This denomination is used for helping the user when picking a
     texture image class in the IDE expert. If it's not overriden,
     takes its value from FriendlyName. *)
    class function FriendlyDescription: string; virtual;
    // Request reload/refresh of data upon next use.
    procedure Invalidate; virtual;
    (*Returns image's bitmap handle.
     If the actual image is not a windows bitmap (BMP), descendants should
     take care of properly converting to bitmap. *)
    function GetBitmap32: TgxImage; virtual;
    (*Request for unloading bitmapData, to free some memory.
     This one is invoked when one no longer needs the Bitmap data
     it got through a call to GetHBitmap.
     Subclasses may ignore this call if the HBitmap was obtained at
     no particular memory cost. *)
    procedure ReleaseBitmap32; virtual;
    // AsBitmap : Returns the TextureImage as a TBitmap
    function AsBitmap: TBitmap;
    procedure AssignToBitmap(aBitmap: TBitmap);
     property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
    property Depth: Integer read GetDepth;
    //Native OpenGL texture target.
    property NativeTextureTarget: TglTextureTarget read GetTextureTarget;
    property ResourceName: string read GetResourceName;
  end;

  TgxTextureImageClass = class of TgxTextureImage;

  (* A texture image with no specified content, only a size.
     This texture image type is of use if the context of your texture is
     calculated at run-time (with a TgxMemoryViewer for instance). *)
  TgxBlankImage = class(TgxTextureImage)
  private
    procedure SetWidth(val: Integer);
    procedure SetHeight(val: Integer);
    procedure SetDepth(val: Integer);
    procedure SetCubeMap(const val: Boolean);
    procedure SetArray(const val: Boolean);
  protected
    fBitmap: TgxImage;
    fWidth, fHeight, fDepth: Integer;
    // Store a icolor format, because fBitmap is not always defined
    fColorFormat: Cardinal;
    // Blank Cube Map
    fCubeMap: Boolean;
    // Flag to interparate depth as layer
    fArray: Boolean;
    function GetWidth: Integer; override;
    function GetHeight: Integer; override;
    function GetDepth: Integer; override;
    function GetTextureTarget: TglTextureTarget; override;
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function GetBitmap32: TgxImage; override;
    procedure ReleaseBitmap32; override;
    procedure SaveToFile(const fileName: string); override;
    procedure LoadFromFile(const fileName: string); override;
    class function FriendlyName: string; override;
    class function FriendlyDescription: string; override;
  published
    // Width, heigth and depth of the blank image (for memory allocation).
    property Width: Integer read GetWidth write SetWidth default 256;
    property Height: Integer read GetHeight write SetHeight default 256;
    property Depth: Integer read GetDepth write SetDepth default 0;
    property CubeMap: Boolean read fCubeMap write SetCubeMap default false;
    property TextureArray: Boolean read fArray write SetArray default false;
    property ColorFormat: Cardinal read fColorFormat write fColorFormat;
  end;

  // Base class for image data classes internally based on a TgxPicture.
  TgxPictureImage = class(TgxTextureImage)
  private
    FBitmap: TgxImage;
    FVKPicture: TImage;
    FUpdateCounter: Integer;
  protected
    function GetHeight: Integer; override;
    function GetWidth: Integer; override;
    function GetDepth: Integer; override;
    function GetTextureTarget: TglTextureTarget; override;
    function GetPicture: TImage;
    procedure SetPicture(const aPicture: TImage);
    procedure PictureChanged(Sender: TObject);
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    (* Use this function if you are going to modify the Picture directly.
     Each invokation MUST be balanced by a call to EndUpdate. *)
    procedure BeginUpdate;
    // Ends a direct picture modification session. Follows a BeginUpdate.
    procedure EndUpdate;
    function GetBitmap32: TgxImage; override;
    procedure ReleaseBitmap32; override;
    // Holds the image content.
    property Picture: TImage read GetPicture write SetPicture;
  end;

  (* Stores any image compatible with Delphi's TgxPicture mechanism.
   The picture's data is actually stored into the DFM, the original
   picture name or path is not remembered. It is similar in behaviour
   to Delphi's TImage.
   Note that if original image is for instance JPEG format, only the JPEG
   data will be stored in the DFM (compact) *)
  TgxPersistentImage = class(TgxPictureImage)
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    procedure SaveToFile(const fileName: string); override;
    procedure LoadFromFile(const fileName: string); override;
    class function FriendlyName: string; override;
    class function FriendlyDescription: string; override;
    property NativeTextureTarget;
  published
    property Picture;
  end;

  (* Uses a picture whose data is found in a file (only filename is stored).
    The image is unloaded after upload to OpenGL. *)
  TgxPicFileImage = class(TgxPictureImage)
  private
    FPictureFileName: string;
    FAlreadyWarnedAboutMissingFile: Boolean;
    FWidth: Integer;
    FHeight: Integer;
  protected
    procedure SetPictureFileName(const val: string);
    function GetWidth: Integer; override;
    function GetHeight: Integer; override;
    function GetDepth: Integer; override;
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    // Only picture file name is saved
    procedure SaveToFile(const fileName: string); override;
    (* Load picture file name or use fileName as picture filename.
       The autodetection is based on the filelength and presence of zeros. *)
    procedure LoadFromFile(const fileName: string); override;
    class function FriendlyName: string; override;
    class function FriendlyDescription: string; override;
    property NativeTextureTarget;
    function GetBitmap32: TgxImage; override;
    procedure Invalidate; override;
  published
    // Filename of the picture to use.
    property PictureFileName: string read FPictureFileName write SetPictureFileName;
  end;

 TgxCubeMapTarget = Integer;

  (* A texture image used for specifying and stroing a cube map.
     Not unlike TgxPictureImage, but storing 6 of them instead of just one.
     Saving & loading as a whole currently not supported. *)
  TgxCubeMapImage = class(TgxTextureImage)
  private
    FImage: TgxImage;
    FUpdateCounter: Integer;
    FPicture: array[cmtPX..cmtNZ] of TImage;
  protected
    function GetWidth: Integer; override;
    function GetHeight: Integer; override;
    function GetDepth: Integer; override;
    procedure SetPicture(index: TgxCubeMapTarget; const val: TImage);
    function GetPicture(index: TgxCubeMapTarget): TImage;
    function GetTextureTarget: TglTextureTarget; override;
    procedure PictureChanged(Sender: TObject);
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function GetBitmap32: TgxImage; override;
    procedure ReleaseBitmap32; override;
    (* Use this function if you are going to modify the Picture directly.
     Each invokation MUST be balanced by a call to EndUpdate. *)
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure SaveToFile(const fileName: string); override;
    procedure LoadFromFile(const fileName: string); override;
    class function FriendlyName: string; override;
    class function FriendlyDescription: string; override;
    property NativeTextureTarget;
    // Indexed access to the cube map's sub pictures.
    property Picture[index: TgxCubeMapTarget]: TImage read GetPicture write SetPicture;
  published
    property PicturePX: TImage index cmtPX read GetPicture write SetPicture;
    property PictureNX: TImage index cmtNX read GetPicture write SetPicture;
    property PicturePY: TImage index cmtPY read GetPicture write SetPicture;
    property PictureNY: TImage index cmtNY read GetPicture write SetPicture;
    property PicturePZ: TImage index cmtPZ read GetPicture write SetPicture;
    property PictureNZ: TImage index cmtNZ read GetPicture write SetPicture;
  end;

  TgxTextureMappingMode = (tmmUser, tmmObjectLinear, tmmEyeLinear, tmmSphere,
    tmmCubeMapReflection, tmmCubeMapNormal, tmmCubeMapLight0, tmmCubeMapCamera);

  (* Defines basic texturing properties.
     You can control texture wrapping, smoothing/filtering and of course define
     the texture map (note that texturing is disabled by default).
     A built-in mechanism (through ImageAlpha) allows auto-generation of an
     Alpha channel for all bitmaps (see TgxTextureImageAlpha). *)
  TgxTexture = class(TgxUpdateAbleObject)
  private
    FTextureHandle: TgxTextureHandle;
    FSamplerHandle: TgxVirtualHandle;
    FTextureFormat: TglInternalFormat;
    FTextureMode: TgxTextureMode;
    FTextureWrap: TgxTextureWrap;
    FMinFilter: TgxMinFilter;
    FMagFilter: TgxMagFilter;
    FDisabled: Boolean;
    FImage: TgxTextureImage;
    FImageAlpha: TgxTextureImageAlpha;
    FImageBrightness: Single;
    FImageGamma: Single;
    FMappingMode: TgxTextureMappingMode;
    FMapSCoordinates: TgxCoordinates4;
    FMapTCoordinates: TgxCoordinates4;
    FMapRCoordinates: TgxCoordinates4;
    FMapQCoordinates: TgxCoordinates4;
    FOnTextureNeeded: TgxTextureNeededEvent;
    FCompression: TgxTextureCompression;
    FRequiredMemorySize: Integer;
    FFilteringQuality: TglTextureFilteringQuality;
    FTexWidth: Integer;
    FTexHeight: Integer;
    FTexDepth: Integer;
    FEnvColor: TgxColor;
    FBorderColor: TgxColor;
    FNormalMapScale: Single;
    FTextureWrapS: TglSeparateTextureWrap;
    FTextureWrapT: TglSeparateTextureWrap;
    FTextureWrapR: TglSeparateTextureWrap;
    fTextureCompareMode: TglTextureCompareMode;
    fTextureCompareFunc: TgxDepthCompareFunc;
    fDepthTextureMode: TgxDepthTextureMode;
    FKeepImageAfterTransfer: Boolean;
  protected
    procedure SetImage(AValue: TgxTextureImage);
    procedure SetImageAlpha(const val: TgxTextureImageAlpha);
    procedure SetImageBrightness(const val: Single);
    function StoreBrightness: Boolean;
    procedure SetImageGamma(const val: Single);
    function StoreGamma: Boolean;
    procedure SetMagFilter(AValue: TgxMagFilter);
    procedure SetMinFilter(AValue: TgxMinFilter);
    procedure SetTextureMode(AValue: TgxTextureMode);
    procedure SetTextureWrap(AValue: TgxTextureWrap);
    procedure SetTextureWrapS(AValue: TglSeparateTextureWrap);
    procedure SetTextureWrapT(AValue: TglSeparateTextureWrap);
    procedure SetTextureWrapR(AValue: TglSeparateTextureWrap);
    function GetTextureFormat: TgxTextureFormat;
    procedure SetTextureFormat(const val: TgxTextureFormat);
    procedure SetTextureFormatEx(const val: TglInternalFormat);
    function StoreTextureFormatEx: Boolean;
    procedure SetCompression(const val: TgxTextureCompression);
    procedure SetFilteringQuality(const val: TglTextureFilteringQuality);
    procedure SetMappingMode(const val: TgxTextureMappingMode);
    function GetMappingSCoordinates: TgxCoordinates4;
    procedure SetMappingSCoordinates(const val: TgxCoordinates4);
    function StoreMappingSCoordinates: Boolean;
    function GetMappingTCoordinates: TgxCoordinates4;
    procedure SetMappingTCoordinates(const val: TgxCoordinates4);
    function StoreMappingTCoordinates: Boolean;
    function GetMappingRCoordinates: TgxCoordinates4;
    procedure SetMappingRCoordinates(const val: TgxCoordinates4);
    function StoreMappingRCoordinates: Boolean;
    function GetMappingQCoordinates: TgxCoordinates4;
    procedure SetMappingQCoordinates(const val: TgxCoordinates4);
    function StoreMappingQCoordinates: Boolean;
    procedure SetDisabled(AValue: Boolean);
    procedure SetEnabled(const val: Boolean);
    function GetEnabled: Boolean;
    procedure SetEnvColor(const val: TgxColor);
    procedure SetBorderColor(const val: TgxColor);
    procedure SetNormalMapScale(const val: Single);
    procedure SetTextureCompareMode(const val: TglTextureCompareMode);
    procedure SetTextureCompareFunc(const val: TgxDepthCompareFunc);
    procedure SetDepthTextureMode(const val: TgxDepthTextureMode);
    function StoreNormalMapScale: Boolean;
    function StoreImageClassName: Boolean;
    function GetHandle: Cardinal; virtual;
    // Load texture to OpenGL subsystem
    procedure PrepareImage(target: Cardinal); virtual;
    // Setup OpenGL texture parameters
    procedure PrepareParams(target: Cardinal); virtual;
    procedure DoOnTextureNeeded(Sender: TObject; var textureFileName: string);
    procedure OnSamplerAllocate(Sender: TgxVirtualHandle; var Handle: Cardinal);
    procedure OnSamplerDestroy(Sender: TgxVirtualHandle; var Handle: Cardinal);
    // Shows a special image that indicates an error
    procedure SetTextureErrorImage;
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    property OnTextureNeeded: TgxTextureNeededEvent read FOnTextureNeeded write
      FOnTextureNeeded;
    procedure PrepareBuildList;
    procedure ApplyMappingMode;
    procedure UnApplyMappingMode;
    procedure Apply(var rci: TgxRenderContextInfo);
    procedure UnApply(var rci: TgxRenderContextInfo);
    // Applies to TEXTURE1
    procedure ApplyAsTexture2(var rci: TgxRenderContextInfo; textureMatrix: PMatrix4f = nil);
    procedure UnApplyAsTexture2(var rci: TgxRenderContextInfo;
      reloadIdentityTextureMatrix: boolean);
    {N=1 for TEXTURE0, N=2 for TEXTURE1, etc. }
    procedure ApplyAsTextureN(n: Integer; var rci: TgxRenderContextInfo;
      textureMatrix: PMatrix4f = nil);
    procedure UnApplyAsTextureN(n: Integer; var rci: TgxRenderContextInfo;
      reloadIdentityTextureMatrix: boolean);
    procedure Assign(Source: TPersistent); override;
    procedure NotifyChange(Sender: TObject); override;
    procedure NotifyImageChange;
    procedure NotifyParamsChange;
    procedure DestroyHandles;
    procedure SetImageClassName(const val: string);
    function GetImageClassName: string;
    (* Returns the OpenGL memory used by the texture.
      The compressed size is returned if, and only if texture compression
      if active and possible, and the texture has been allocated (Handle
      is defined), otherwise the estimated size (from TextureFormat
      specification) is returned. *)
    function TextureImageRequiredMemory: Integer;
    (* Allocates the texture handle if not already allocated.
      The texture is binded and parameters are setup, but no image data
      is initialized by this call - for expert use only. *)
    function AllocateHandle: Cardinal;
    function IsHandleAllocated: Boolean;
    // Returns OpenGL texture format corresponding to current options.
    function OpenGLTextureFormat: Integer;
    //Returns if of float data type
    function IsFloatType: Boolean;
    // Is the texture enabled? Always equals to 'not Disabled'.
    property Enabled: Boolean read GetEnabled write SetEnabled;
    (* Handle to the OpenGL texture object.
      If the handle hasn't already been allocated, it will be allocated
      by this call (ie. do not use if no OpenGL context is active!) *)
    property Handle: Cardinal read GetHandle;
    property TextureHandle: TgxTextureHandle read FTextureHandle;
    // Actual width, height and depth used for last texture specification binding.
    property TexWidth: Integer read FTexWidth;
    property TexHeight: Integer read FTexHeight;
    property TexDepth: Integer read FTexDepth;
    //Give texture rendering context
  published
    (* Image ClassName for enabling True polymorphism.
    This is ugly, but since the default streaming mechanism does a
    really bad job at storing	polymorphic owned-object properties,
    and neither TFiler nor TgxPicture allow proper use of the built-in
    streaming, that's the only way I found to allow a user-extensible
    mechanism. *)
    property ImageClassName: string read GetImageClassName write
      SetImageClassName stored StoreImageClassName;
    // Image data for the texture.
    property Image: TgxTextureImage read FImage write SetImage;
    (* Automatic Image Alpha setting.
    Allows to control how and if the image's Alpha channel (transparency)
    is computed. *)
    property ImageAlpha: TgxTextureImageAlpha read FImageAlpha write
      SetImageAlpha default tiaDefault;
    (* Texture brightness correction.
    This correction is applied upon loading a TgxTextureImage, it's a
    simple saturating scaling applied to the RGB components of
    the 32 bits image, before it is passed to OpenGL, and before
    gamma correction (if any). *)
    property ImageBrightness: Single read FImageBrightness write
      SetImageBrightness stored StoreBrightness;
    (* Texture gamma correction.
    The gamma correction is applied upon loading a TgxTextureImage,
    applied to the RGB components of the 32 bits image, before it is
    passed to OpenGL, after brightness correction (if any). *)
    property ImageGamma: Single read FImageGamma write SetImageGamma stored StoreGamma;
    // Texture magnification filter.
    property MagFilter: TgxMagFilter read FMagFilter write SetMagFilter default maLinear;
    // Texture minification filter.
    property MinFilter: TgxMinFilter read FMinFilter write SetMinFilter default miLinearMipMapLinear;
    // Texture application mode.
    property TextureMode: TgxTextureMode read FTextureMode write SetTextureMode default tmDecal;
    // Wrapping mode for the texture.
    property TextureWrap: TgxTextureWrap read FTextureWrap write SetTextureWrap default twBoth;
    // Wrapping mode for the texture when TextureWrap=twSeparate.
    property TextureWrapS: TglSeparateTextureWrap read FTextureWrapS write
      SetTextureWrapS default twRepeat;
    property TextureWrapT: TglSeparateTextureWrap read FTextureWrapT write
      SetTextureWrapT default twRepeat;
    property TextureWrapR: TglSeparateTextureWrap read FTextureWrapR write
      SetTextureWrapR default twRepeat;
    // Texture format for use by the renderer. See TgxTextureFormat for details.
    property TextureFormat: TgxTextureFormat read GetTextureFormat write
      SetTextureFormat default tfDefault;
    property TextureFormatEx: TglInternalFormat read FTextureFormat write
      SetTextureFormatEx stored StoreTextureFormatEx;
    (* Texture compression control.
    If True the compressed TextureFormat variant (the OpenGL ICD must
    support GL_ARB_texture_compression, or this option is ignored). *)
    property Compression: TgxTextureCompression read FCompression write
      SetCompression default tcDefault;
    (*Specifies texture filtering quality.
    You can choose between bilinear and trilinear filetring (anisotropic).
    The OpenGL ICD must support GL_EXT_texture_filter_anisotropic or
    this property is ignored. *)
    property FilteringQuality: TglTextureFilteringQuality read FFilteringQuality
      write SetFilteringQuality default tfIsotropic;
    (* Texture coordinates mapping mode.
    This property controls automatic texture coordinates generation. *)
    property MappingMode: TgxTextureMappingMode read FMappingMode write
      SetMappingMode default tmmUser;
    (* Texture mapping coordinates mode for S, T, R and Q axis.
    This property stores the coordinates for automatic texture
    coordinates generation. *)
    property MappingSCoordinates: TgxCoordinates4 read GetMappingSCoordinates
      write SetMappingSCoordinates stored StoreMappingSCoordinates;
    property MappingTCoordinates: TgxCoordinates4 read GetMappingTCoordinates
      write SetMappingTCoordinates stored StoreMappingTCoordinates;
    property MappingRCoordinates: TgxCoordinates4 read GetMappingRCoordinates
      write SetMappingRCoordinates stored StoreMappingRCoordinates;
    property MappingQCoordinates: TgxCoordinates4 read GetMappingQCoordinates
      write SetMappingQCoordinates stored StoreMappingQCoordinates;
    // Texture Environment color.
    property EnvColor: TgxColor read FEnvColor write SetEnvColor;
    // Texture Border color.
    property BorderColor: TgxColor read FBorderColor write SetBorderColor;
    // If true, the texture is disabled (not used).
    property Disabled: Boolean read FDisabled write SetDisabled default True;
    (* Normal Map scaling.
    Only applies when TextureFormat is tfNormalMap, this property defines
    the scaling that is applied during normal map generation (ie. controls
    the intensity of the bumps). *)
    property NormalMapScale: Single read FNormalMapScale write SetNormalMapScale
      stored StoreNormalMapScale;
     property TextureCompareMode: TglTextureCompareMode read fTextureCompareMode
      write SetTextureCompareMode default tcmNone;
    property TextureCompareFunc: TgxDepthCompareFunc read fTextureCompareFunc
      write SetTextureCompareFunc default cfLequal;
    property DepthTextureMode: TgxDepthTextureMode read fDepthTextureMode write
      SetDepthTextureMode default dtmLuminance;
    // Disable image release after transfering it to VGA.
    property KeepImageAfterTransfer: Boolean read FKeepImageAfterTransfer
      write FKeepImageAfterTransfer default False;
  end;

  TgxTextureExItem = class(TCollectionItem, IgxTextureNotifyAble)
  private
    FTexture: TgxTexture;
    FTextureIndex: Integer;
    FTextureOffset, FTextureScale: TgxCoordinates;
    FTextureMatrixIsIdentity: Boolean;
    FTextureMatrix: TMatrix4f;
    FApplied: Boolean;
     //implementing IInterface
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  protected
    function GetDisplayName: string; override;
    function GetOwner: TPersistent; override;
    procedure SetTexture(const Value: TgxTexture);
    procedure SetTextureIndex(const Value: Integer);
    procedure SetTextureOffset(const Value: TgxCoordinates);
    procedure SetTextureScale(const Value: TgxCoordinates);
    procedure NotifyTexMapChange(Sender: TObject);
    procedure CalculateTextureMatrix;
    procedure OnNotifyChange(Sender: TObject);
  public
    constructor Create(ACollection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure NotifyChange(Sender: TObject);
    procedure Apply(var rci: TgxRenderContextInfo);
    procedure UnApply(var rci: TgxRenderContextInfo);
  published
    property Texture: TgxTexture read FTexture write SetTexture;
    property TextureIndex: Integer read FTextureIndex write SetTextureIndex;
    property TextureOffset: TgxCoordinates read FTextureOffset write SetTextureOffset;
    property TextureScale: TgxCoordinates read FTextureScale write SetTextureScale;
  end;

  TgxTextureEx = class(TCollection)
  private
    FOwner: TgxUpdateAbleObject;
  protected
    procedure SetItems(index: Integer; const Value: TgxTextureExItem);
    function GetItems(index: Integer): TgxTextureExItem;
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TgxUpdateAbleObject);
    procedure NotifyChange(Sender: TObject);
    procedure Apply(var rci: TgxRenderContextInfo);
    procedure UnApply(var rci: TgxRenderContextInfo);
    function IsTextureEnabled(Index: Integer): Boolean;
    function Add: TgxTextureExItem;
    property Items[index: Integer]: TgxTextureExItem read GetItems write
    SetItems; default;
    procedure Loaded;
  end;

  ETexture = class(Exception);
  EShaderException = class(Exception);

// Register a TgxTextureImageClass (used for persistence and IDE purposes)
procedure RegisterTextureImageClass(textureImageClass: TgxTextureImageClass);
// Finds a registerer TgxTextureImageClass using its classname
function FindTextureImageClass(const className: string): TgxTextureImageClass;
// Finds a registerer TgxTextureImageClass using its FriendlyName
function FindTextureImageClassByFriendlyName(const friendlyName: string):
  TgxTextureImageClass;
// Defines a TStrings with the list of registered TgxTextureImageClass.
procedure SetTextureImageClassesToStrings(aStrings: TStrings);
(* Creates a TStrings with the list of registered TgxTextureImageClass.
 To be freed by caller. *)
function GetTextureImageClassesAsStrings: TStrings;
procedure RegisterTGraphicClassFileExtension(const extension: string;
  const aClass: TGraphicClass);
function CreateGraphicFromFile(const fileName: string): TBitmap;

//------------------------------------------------------------------------------
implementation
//------------------------------------------------------------------------------

uses
  GXS.Scene, // TODO: remove dependancy on Scene.pas unit (related to tmmCubeMapLight0)
  GXS.PictureRegisteredFormats;

const
  cTextureMode: array[tmDecal..tmAdd] of Cardinal =
    (GL_DECAL, GL_MODULATE, GL_BLEND, GL_REPLACE, GL_ADD);

  cOldTextureFormatToInternalFormat: array[tfRGB..tfRGBAFloat32] of
    TglInternalFormat = (
    tfRGB8,
    tfRGBA8,
    tfRGB5,
    tfRGBA4,
    tfALPHA8,
    tfLUMINANCE8,
    tfLUMINANCE8_ALPHA8,
    tfINTENSITY8,
    tfRGB8,
    tfRGBA_FLOAT16,
    tfRGBA_FLOAT32);

var
  vGxTextureImageClasses: TList;
  vTGraphicFileExtension: array of string;
  vTGraphicClass: array of TGraphicClass;

type
  TFriendlyImage = class(TgxBaseImage);

// Dummy methods for CPP
//
function TgxTextureImage.GetTextureTarget: TglTextureTarget;
begin
end;

function TgxTextureImage.GetHeight: Integer;
begin
  Result := 0;
end;

function TgxTextureImage.GetWidth: Integer;
begin
  Result := 0;
end;

function TgxTextureImage.GetDepth: Integer;
begin
  Result := 0;
end;

procedure TgxTextureImage.SaveToFile(const FileName: String);
begin
end;

class function TgxTextureImage.FriendlyName: String;
begin
  Result := '';
end;

function TgxTextureImage.GetBitmap32: TgxImage;
begin
  Result := nil;
end;

procedure RegisterTGraphicClassFileExtension(const extension: string;
  const aClass: TGraphicClass);
var
  n: Integer;
begin
  n := Length(vTGraphicFileExtension);
  SetLength(vTGraphicFileExtension, n + 1);
  SetLength(vTGraphicClass, n + 1);
  vTGraphicFileExtension[n] := LowerCase(extension);
  vTGraphicClass[n] := aClass;
end;

function CreateGraphicFromFile(const fileName: string): TBitmap;
var
  i: Integer;
  ext: string;
  fs: TStream;
  graphicClass: TGraphicClass;
begin
  Result := nil;
  if FileStreamExists(fileName) then
  begin
    graphicClass := nil;
    ext := LowerCase(ExtractFileExt(fileName));
    for i := 0 to High(vTGraphicFileExtension) do
    begin
      if vTGraphicFileExtension[i] = ext then
      begin
        graphicClass := TGraphicClass(vTGraphicClass[i]);
        Break;
      end;
    end;
    if graphicClass = nil then
      graphicClass := GraphicClassForExtension(ext);
    if graphicClass <> nil then
    begin
      Result := graphicClass.Create;
      try
        fs := TFileStream.Create(fileName, fmOpenRead);
        try
          Result.LoadFromStream(fs);
        finally
          fs.Free;
        end;
      except
        FreeAndNil(Result);
        raise;
      end;
    end;
  end;
end;

procedure RegisterTextureImageClass(textureImageClass: TgxTextureImageClass);
begin
  if not Assigned(vGxTextureImageClasses) then
    vGxTextureImageClasses := TList.Create;
  vGxTextureImageClasses.Add(textureImageClass);
end;

function FindTextureImageClass(const className: string): TgxTextureImageClass;
var
  i: Integer;
  tic: TgxTextureImageClass;
begin
  Result := nil;
  if Assigned(vGxTextureImageClasses) then
    for i := 0 to vGxTextureImageClasses.Count - 1 do
    begin
      tic := TgxTextureImageClass(vGxTextureImageClasses[i]);
      if tic.ClassName = className then
      begin
        Result := tic;
        Break;
      end;
    end;

end;

function FindTextureImageClassByFriendlyName(const friendlyName: string):
  TgxTextureImageClass;
var
  i: Integer;
  tic: TgxTextureImageClass;
begin
  Result := nil;
  if Assigned(vGxTextureImageClasses) then
    for i := 0 to vGxTextureImageClasses.Count - 1 do
    begin
      tic := TgxTextureImageClass(vGxTextureImageClasses[i]);
      if tic.FriendlyName = friendlyName then
      begin
        Result := tic;
        Break;
      end;
    end;
end;

procedure SetTextureImageClassesToStrings(aStrings: TStrings);
var
  i: Integer;
  tic: TgxTextureImageClass;
begin
  with aStrings do
  begin
    BeginUpdate;
    Clear;
    if Assigned(vGxTextureImageClasses) then
      for i := 0 to vGxTextureImageClasses.Count - 1 do
      begin
        tic := TgxTextureImageClass(vGxTextureImageClasses[i]);
        AddObject(tic.FriendlyName, TObject(Pointer(tic)));
      end;
    EndUpdate;
  end;
end;

function GetTextureImageClassesAsStrings: TStrings;
begin
  Result := TStringList.Create;
  SetTextureImageClassesToStrings(Result);
end;



// ------------------
// ------------------ TgxTextureImage ------------------
// ------------------

constructor TgxTextureImage.Create(AOwner: TPersistent);
begin
  inherited;
  FOwnerTexture := (AOwner as TgxTexture);
end;

destructor TgxTextureImage.Destroy;
begin
  inherited Destroy;
end;

class function TgxTextureImage.FriendlyDescription: string;
begin
  Result := FriendlyName;
end;

procedure TgxTextureImage.Invalidate;
begin
  ReleaseBitmap32;
  NotifyChange(Self);
end;

procedure TgxTextureImage.ReleaseBitmap32;
begin
  // nothing here.
end;

// AsBitmap : Returns the TextureImage as a TBitmap
// WARNING: This Creates a new bitmap. Remember to free it, to prevent leaks.
// If possible, rather use AssignToBitmap.
//
function TgxTextureImage.AsBitmap: TBitmap;
begin
  result := self.GetBitmap32.Create32BitsBitmap;
end;

procedure TgxTextureImage.AssignToBitmap(aBitmap: TBitmap);
begin
  Self.GetBitmap32.AssignToBitmap(aBitmap);
end;

procedure TgxTextureImage.NotifyChange(Sender: TObject);
begin
  if Assigned(FOwnerTexture) then
  begin
    FOwnerTexture.FTextureHandle.NotifyChangesOfData;
    FOwnerTexture.FSamplerHandle.NotifyChangesOfData;
    // Check for texture target change
    GetTextureTarget;
    FOwnerTexture.NotifyChange(Self);
  end;
end;

procedure TgxTextureImage.LoadFromFile(const fileName: string);
var
  buf: string;
begin
  if Assigned(FOnTextureNeeded) then
  begin
    buf := fileName;
    FOnTextureNeeded(Self, buf);
  end;
end;

function TgxTextureImage.GetResourceName: string;
begin
  Result := FResourceFile;
end;

class function TgxTextureImage.IsSelfLoading: Boolean;
begin
  Result := False;
end;

procedure TgxTextureImage.LoadTexture(AInternalFormat: TglInternalFormat);
begin
end;


// ------------------
// ------------------ TgxBlankImage ------------------
// ------------------

constructor TgxBlankImage.Create(AOwner: TPersistent);
begin
  inherited;
  fWidth := 256;
  fHeight := 256;
  fDepth := 0;
  fColorFormat := GL_RGBA;
end;

destructor TgxBlankImage.Destroy;
begin
  ReleaseBitmap32;
  inherited Destroy;
end;

procedure TgxBlankImage.Assign(Source: TPersistent);
var
  img: TgxBlankImage;
begin
  if Assigned(Source) then
  begin
    if (Source is TgxBlankImage) then
    begin
      img := Source as TgxBlankImage;
      FWidth := img.Width;
      FHeight := img.Height;
      FDepth := img.Depth;
      FCubeMap := img.fCubeMap;
      FArray := img.fArray;
      fColorFormat := img.ColorFormat;
      FResourceFile := img.ResourceName;
      Invalidate;
    end
    else
      GetBitmap32.Assign(Source);
    NotifyChange(Self);
  end
  else
    inherited;
end;

procedure TgxBlankImage.SetWidth(val: Integer);
begin
  if val <> FWidth then
  begin
    FWidth := val;
    if FWidth < 1 then
      FWidth := 1;
    Invalidate;
  end;
end;

function TgxBlankImage.GetWidth: Integer;
begin
  Result := FWidth;
end;

procedure TgxBlankImage.SetHeight(val: Integer);
begin
  if val <> FHeight then
  begin
    FHeight := val;
    if FHeight < 1 then
      FHeight := 1;
    Invalidate;
  end;
end;

function TgxBlankImage.GetHeight: Integer;
begin
  Result := FHeight;
end;

procedure TgxBlankImage.SetDepth(val: Integer);
begin
  if val <> FDepth then
  begin
    FDepth := val;
    if FDepth < 0 then
      FDepth := 0;
    Invalidate;
  end;
end;

function TgxBlankImage.GetDepth: Integer;
begin
  Result := fDepth;
end;

procedure TgxBlankImage.SetCubeMap(const val: Boolean);
begin
  if val <> fCubeMap then
  begin
    fCubeMap := val;
    Invalidate;
  end;
end;

procedure TgxBlankImage.SetArray(const val: Boolean);
begin
  if val <> fArray then
  begin
    fArray := val;
    Invalidate;
  end;
end;

function TgxBlankImage.GetBitmap32: TgxImage;
begin
  if not Assigned(FBitmap) then
  begin
    fBitmap := TgxImage.Create;
    fBitmap.Width := FWidth;
    fBitmap.Height := FHeight;
    fBitmap.Depth := FDepth;
    fBitmap.CubeMap := FCubeMap;
    fBitmap.TextureArray := FArray;
    fBitmap.SetColorFormatDataType(FColorFormat, GL_UNSIGNED_BYTE);
  end;
  Result := FBitmap;
end;

procedure TgxBlankImage.ReleaseBitmap32;
begin
  if Assigned(FBitmap) then
  begin
    FBitmap.Free;
    FBitmap := nil;
  end;
end;

procedure TgxBlankImage.SaveToFile(const fileName: string);
begin
  SaveAnsiStringToFile(fileName, AnsiString(
    '[BlankImage]'#13#10'Width=' + IntToStr(Width) +
    #13#10'Height=' + IntToStr(Height) +
    #13#10'Depth=' + IntToStr(Depth)));
end;

procedure TgxBlankImage.LoadFromFile(const fileName: string);
var
  sl: TStringList;
  buf, temp: string;
begin
  buf := fileName;
  if Assigned(FOnTextureNeeded) then
    FOnTextureNeeded(Self, buf);
  if FileExists(buf) then
  begin
    sl := TStringList.Create;
    try
      sl.LoadFromFile(buf, TEncoding.ASCII);
      FWidth := StrToInt(sl.Values['Width']);
      FHeight := StrToInt(sl.Values['Height']);
      temp := sl.Values['Depth'];
      if Length(temp) > 0 then
        FDepth := StrToInt(temp)
      else
        FDepth := 1;
    finally
      sl.Free;
    end;
  end
  else
  begin
    Assert(False, Format(strFailedOpenFile, [fileName]));
  end;
end;

class function TgxBlankImage.FriendlyName: string;
begin
  Result := 'Blank Image';
end;

class function TgxBlankImage.FriendlyDescription: string;
begin
  Result := 'Blank Image (Width x Height x Depth)';
end;

function TgxBlankImage.GetTextureTarget: TglTextureTarget;
begin
  Result := ttTexture2D;
  // Choose a texture target
  if Assigned(fBitmap) then
  begin
    FWidth := fBitmap.Width;
    FHeight := fBitmap.Height;
    FDepth := fBitmap.Depth;
    FCubeMap := fBitmap.CubeMap;
    FArray := fBitmap.TextureArray;
  end;

  if FHeight = 1 then
    Result := ttTexture1D;
  if FCubeMap then
    Result := ttTextureCube;
  if FDepth > 0 then
    Result := ttTexture3D;
  if FArray then
  begin
    if FDepth < 2 then
      Result := ttTexture1DArray
    else
      Result := ttTexture2DArray;
    if FCubeMap then
      Result := ttTextureCubeArray;
  end;

  if Assigned(FOwnerTexture) then
  begin
    if ((FOwnerTexture.FTextureFormat >= tfFLOAT_R16)
      and (FOwnerTexture.FTextureFormat <= tfFLOAT_RGBA32)) then
      Result := ttTextureRect;
  end;
end;


// ------------------
// ------------------ TgxPictureImage ------------------
// ------------------

constructor TgxPictureImage.Create(AOwner: TPersistent);
begin
  inherited;
end;

destructor TgxPictureImage.Destroy;
begin
  ReleaseBitmap32;
  FVKPicture.Free;
  inherited Destroy;
end;

procedure TgxPictureImage.Assign(Source: TPersistent);
var
  bmp: TBitmap;
begin
  if Assigned(Source) then
  begin
    if (Source is TgxPersistentImage) then
      Picture.Assign(TgxPersistentImage(Source).Picture)
    else if (Source is TBitmap) then
      Picture.Assign(Source)
    else if (Source is TImage) then
      Picture.Assign(Source)
    else if (Source is TgxImage) then
    begin
      bmp := TgxImage(Source).Create32BitsBitmap;
      Picture.Bitmap := bmp;
      bmp.Free;
      FResourceFile := TgxImage(Source).ResourceName;
    end
    else
      inherited;
  end
  else
    inherited;
end;

procedure TgxPictureImage.BeginUpdate;
begin
  Inc(FUpdateCounter);
  Picture.Bitmap.OnChange := nil;
end;

procedure TgxPictureImage.EndUpdate;
begin
  Assert(FUpdateCounter > 0, ClassName + ': Unbalanced Begin/EndUpdate');
  Dec(FUpdateCounter);
  Picture.Bitmap.OnChange := PictureChanged;
  if FUpdateCounter = 0 then
    PictureChanged(Picture);
end;

function TgxPictureImage.GetHeight: Integer;
begin
  Result := Picture.Bitmap.Height;
end;

function TgxPictureImage.GetWidth: Integer;
begin
  Result := Picture.Bitmap.Width;
end;

function TgxPictureImage.GetDepth: Integer;
begin
  Result := 0;
end;

function TgxPictureImage.GetBitmap32: TgxImage;
begin
  if not Assigned(FBitmap) then
  begin
    FBitmap := TgxImage.Create;
    // we need to deactivate OnChange, due to a "glitch" in some TGraphics,
    // for instance, TJPegImage triggers an OnChange when it is drawn...
    if Assigned(Picture.Bitmap) then
    begin
      if Assigned(Picture.Bitmap.OnChange) then
      begin
        Picture.Bitmap.OnChange := nil;
        try
          FBitmap.Assign(Picture.Bitmap);
        finally
          Picture.Bitmap.OnChange := PictureChanged;
        end;
      end
      else
        FBitmap.Assign(Picture.Bitmap);
    end
    else
      FBitmap.SetErrorImage;
  end;
  Result := FBitmap;
end;

procedure TgxPictureImage.ReleaseBitmap32;
begin
  if Assigned(FBitmap) then
  begin
    FBitmap.Free;
    FBitmap := nil;
  end;
end;

procedure TgxPictureImage.PictureChanged(Sender: TObject);
begin
  Invalidate;
end;

function TgxPictureImage.GetPicture: TImage;
begin
  if not Assigned(FVKPicture) then
  begin
    FVKPicture := TImage.Create(nil);
    FVKPicture.Bitmap.OnChange := PictureChanged;
  end;
  Result := FVKPicture;
end;

procedure TgxPictureImage.SetPicture(const aPicture: TImage);
begin
  Picture.Assign(aPicture);
end;

function TgxPictureImage.GetTextureTarget: TglTextureTarget;
begin
  Result := ttTexture2D;
end;


// ------------------
// ------------------ TgxPersistentImage ------------------
// ------------------


constructor TgxPersistentImage.Create(AOwner: TPersistent);
begin
  inherited;
end;

destructor TgxPersistentImage.Destroy;
begin
  inherited Destroy;
end;

procedure TgxPersistentImage.SaveToFile(const fileName: string);
begin
  Picture.Bitmap.SaveToFile(fileName);
  FResourceFile := fileName;
end;

procedure TgxPersistentImage.LoadFromFile(const fileName: string);
var
  buf: string;
  gr: TBitmap;
begin
  buf := fileName;
  FResourceFile := fileName;
  if Assigned(FOnTextureNeeded) then
    FOnTextureNeeded(Self, buf);
  if ApplicationFileIODefined then
  begin
    gr := CreateGraphicFromFile(buf);
    if Assigned(gr) then
    begin
      Picture.Bitmap := gr;
      gr.Free;
      Exit;
    end;
  end
  else if FileExists(buf) then
  begin
    Picture.Bitmap.LoadFromFile(buf);
    Exit;
  end;
  Picture.Bitmap := nil;
  raise ETexture.CreateFmt(strFailedOpenFile, [fileName]);
end;

class function TgxPersistentImage.FriendlyName: string;
begin
  Result := 'Persistent Image';
end;

class function TgxPersistentImage.FriendlyDescription: string;
begin
  Result := 'Image data is stored in its original format with other form resources,'
    + 'ie. in the DFM at design-time, and embedded in the EXE at run-time.';
end;

// ------------------
// ------------------ TgxPicFileImage ------------------
// ------------------

constructor TgxPicFileImage.Create(AOwner: TPersistent);
begin
  inherited;
end;

destructor TgxPicFileImage.Destroy;
begin
  inherited;
end;

procedure TgxPicFileImage.Assign(Source: TPersistent);
begin
  if Source is TgxPicFileImage then
  begin
    FPictureFileName := TgxPicFileImage(Source).FPictureFileName;
    FResourceFile := TgxPicFileImage(Source).ResourceName;
  end
  else
    inherited;
end;

procedure TgxPicFileImage.SetPictureFileName(const val: string);
begin
  if val <> FPictureFileName then
  begin
    FPictureFileName := val;
    FResourceFile := val;
    FAlreadyWarnedAboutMissingFile := False;
    Invalidate;
  end;
end;

procedure TgxPicFileImage.Invalidate;
begin
  Picture.Bitmap.OnChange := nil;
  try
    Picture.Assign(nil);
    FBitmap := nil;
  finally
    Picture.Bitmap.OnChange := PictureChanged;
  end;
  inherited;
end;

function TgxPicFileImage.GetHeight: Integer;
begin
  Result := FHeight;
end;

function TgxPicFileImage.GetWidth: Integer;
begin
  Result := FWidth;
end;

function TgxPicFileImage.GetDepth: Integer;
begin
  Result := 0;
end;

function TgxPicFileImage.GetBitmap32: TgxImage;
var
  buf: string;
  gr: TBitmap;
begin
  if (GetWidth <= 0) and (PictureFileName <> '') then
  begin
    Picture.Bitmap.OnChange := nil;
    try
      buf := PictureFileName;
      SetExeDirectory;
      if Assigned(FOnTextureNeeded) then
        FOnTextureNeeded(Self, buf);
      if FileStreamExists(buf) then
      begin
        gr := CreateGraphicFromFile(buf);
        Picture.Bitmap := gr;
        gr.Free;
      end
      else
      begin
        Picture.Bitmap := nil;
        if not FAlreadyWarnedAboutMissingFile then
        begin
          FAlreadyWarnedAboutMissingFile := True;
          GLOKMessageBox(Format(strFailedOpenFileFromCurrentDir, [PictureFileName, GetCurrentDir]),strError);
        end;
      end;
      Result := inherited GetBitmap32;
      FWidth := Result.Width;
      FHeight := Result.Height;
      Picture.Bitmap := nil;
    finally
      Picture.Bitmap.OnChange := PictureChanged;
    end;
  end
  else
    Result := inherited GetBitmap32;
end;

procedure TgxPicFileImage.SaveToFile(const fileName: string);
begin
  FResourceFile := fileName;
  SaveAnsiStringToFile(fileName, AnsiString(PictureFileName));
end;

 
//

procedure TgxPicFileImage.LoadFromFile(const fileName: string);
var
  buf: string;
begin
  inherited;
  // attempt to autodetect if we are pointed to a file containing
  // a filename or directly to an image
  if SizeOfFile(fileName) < 512 then
  begin
    buf := string(LoadAnsiStringFromFile(fileName));
    if Pos(#0, buf) > 0 then
      PictureFileName := fileName
    else
      PictureFileName := buf;
  end
  else
    PictureFileName := fileName;
  FResourceFile := FPictureFileName;
end;

 
//

class function TgxPicFileImage.FriendlyName: string;
begin
  Result := 'PicFile Image';
end;

// FriendlyDescription
//

class function TgxPicFileImage.FriendlyDescription: string;
begin
  Result := 'Image data is retrieved from a file.';
end;

// ------------------
// ------------------ TgxCubeMapImage ------------------
// ------------------

 
constructor TgxCubeMapImage.Create(AOwner: TPersistent);
var
  i: TgxCubeMapTarget;
begin
  inherited;
  for i := Low(FPicture) to High(FPicture) do
  begin
    FPicture[i] := TImage.Create(nil);
    FPicture[i].Bitmap.OnChange := PictureChanged;
  end;
end;

destructor TgxCubeMapImage.Destroy;
var
  i: TgxCubeMapTarget;
begin
  ReleaseBitmap32;
  for i := Low(FPicture) to High(FPicture) do
    FPicture[i].Free;
  inherited Destroy;
end;

procedure TgxCubeMapImage.Assign(Source: TPersistent);
var
  i: TgxCubeMapTarget;
begin
  if Assigned(Source) then
  begin
    if (Source is TgxCubeMapImage) then
    begin
      for i := Low(FPicture) to High(FPicture) do
        FPicture[i].Assign(TgxCubeMapImage(Source).FPicture[i]);
      Invalidate;
    end
    else
      inherited;
  end
  else
    inherited;
end;

function TgxCubeMapImage.GetWidth: Integer;
begin
  Result := FPicture[cmtPX].Bitmap.Width;
end;

function TgxCubeMapImage.GetHeight: Integer;
begin
  Result := FPicture[cmtPX].Bitmap.Height;
end;

function TgxCubeMapImage.GetDepth: Integer;
begin
  Result := 0;
end;

function TgxCubeMapImage.GetBitmap32: TgxImage;
var
  I: Integer;
  LImage: TgxImage;
begin
  if Assigned(FImage) then
    FImage.Free;
  LImage := TgxImage.Create;
  LImage.VerticalReverseOnAssignFromBitmap := True;

  try
    for I := 0 to 5 do
    begin
      FPicture[TgxCubeMapTarget(I)].Bitmap.OnChange := nil;
      try
        LImage.Assign(FPicture[TgxCubeMapTarget(I)].Bitmap);
        if not Assigned(FImage) then
        begin
          FImage := TgxImage.Create;
          FImage.Blank := True;
          FImage.Width := LImage.Width;
          FImage.Height := LImage.Height;
          FImage.SetColorFormatDataType(LImage.ColorFormat, LImage.DataType);
          FImage.CubeMap := True;
          FImage.Blank := False;
        end;
        Move(LImage.Data^, TFriendlyImage(FImage).GetLevelAddress(0, I)^, LImage.LevelSizeInByte[0]);
      finally
        FPicture[TgxCubeMapTarget(I)].Bitmap.OnChange := PictureChanged;
      end;
    end;
  finally
    LImage.Destroy;
  end;
  Result := FImage;
end;

// ReleaseBitmap32
//

procedure TgxCubeMapImage.ReleaseBitmap32;
begin
  if Assigned(FImage) then
  begin
    FImage.Free;
    FImage := nil;
  end;
end;

procedure TgxCubeMapImage.BeginUpdate;
var
  i: TgxCubeMapTarget;
begin
  Inc(FUpdateCounter);
  for i := Low(FPicture) to High(FPicture) do
    FPicture[i].Bitmap.OnChange := nil;
end;

procedure TgxCubeMapImage.EndUpdate;
var
  i: TgxCubeMapTarget;
begin
  Assert(FUpdateCounter > 0, ClassName + ': Unbalanced Begin/EndUpdate');
  Dec(FUpdateCounter);
  for i := Low(FPicture) to High(FPicture) do
    FPicture[i].Bitmap.OnChange := PictureChanged;
  if FUpdateCounter = 0 then
    PictureChanged(FPicture[cmtPX]);
end;

procedure TgxCubeMapImage.SaveToFile(const fileName: string);
var
  fs: TFileStream;
  bmp: TBitmap;
  i: TgxCubeMapTarget;
  version: Word;
begin
  fs := TFileStream.Create(fileName, fmCreate);
  bmp := TBitmap.Create;
  try
    version := $0100;
    fs.Write(version, 2);
    for i := Low(FPicture) to High(FPicture) do
    begin
      bmp.Assign(FPicture[i].Bitmap);
      bmp.SaveToStream(fs);
    end;
  finally
    bmp.Free;
    fs.Free;
  end;
end;

 
procedure TgxCubeMapImage.LoadFromFile(const fileName: string);
var
  fs: TFileStream;
  bmp: TBitmap;
  i: TgxCubeMapTarget;
  version: Word;
begin
  fs := TFileStream.Create(fileName, fmOpenRead + fmShareDenyWrite);
  bmp := TBitmap.Create;
  try
    fs.Read(version, 2);
    Assert(version = $0100);
    for i := Low(FPicture) to High(FPicture) do
    begin
      bmp.LoadFromStream(fs);
      FPicture[i].Bitmap := bmp;
    end;
  finally
    bmp.Free;
    fs.Free;
  end;
end;

 
class function TgxCubeMapImage.FriendlyName: string;
begin
  Result := 'CubeMap Image';
end;

class function TgxCubeMapImage.FriendlyDescription: string;
begin
  Result := 'Image data is contain 6 pictures of cubemap faces.';
end;

procedure TgxCubeMapImage.PictureChanged(Sender: TObject);
begin
  Invalidate;
end;

function TgxCubeMapImage.GetTextureTarget: TglTextureTarget;
begin
  Result := ttTextureCube;
end;

procedure TgxCubeMapImage.SetPicture(index: TgxCubeMapTarget; const val: TImage);
begin
  FPicture[index].Assign(val);
end;

function TgxCubeMapImage.GetPicture(index: TgxCubeMapTarget): TImage;
begin
  Result := FPicture[index];
end;


// ------------------
// ------------------ TgxTexture ------------------
// ------------------

constructor TgxTexture.Create(AOwner: TPersistent);
begin
  inherited;
  FDisabled := True;
  FImage := TgxPersistentImage.Create(Self);
  FImage.OnTextureNeeded := DoOnTextureNeeded;
  FImageAlpha := tiaDefault;
  FImageBrightness := 1.0;
  FImageGamma := 1.0;
  FMagFilter := maLinear;
  FMinFilter := miLinearMipMapLinear;
  FFilteringQuality := tfIsotropic;
  FRequiredMemorySize := -1;
  FTextureHandle := TgxTextureHandle.Create;
  FSamplerHandle := TgxVirtualHandle.Create;
  FSamplerHandle.OnAllocate := OnSamplerAllocate;
  FSamplerHandle.OnDestroy := OnSamplerDestroy;
  FMappingMode := tmmUser;
  FEnvColor := TgxColor.CreateInitialized(Self, clrTransparent);
  FBorderColor := TgxColor.CreateInitialized(Self, clrTransparent);
  FNormalMapScale := cDefaultNormalMapScale;
  FTextureCompareMode := tcmNone;
  FTextureCompareFunc := cfLequal;
  FDepthTextureMode := dtmLuminance;
  TextureFormat := tfDefault;
  FCompression := tcDefault;
  FKeepImageAfterTransfer := False;
end;

destructor TgxTexture.Destroy;
begin
  FEnvColor.Free;
  FBorderColor.Free;
  FMapSCoordinates.Free;
  FMapTCoordinates.Free;
  FMapRCoordinates.Free;
  FMapQCoordinates.Free;
  DestroyHandles;
  FTextureHandle.Free;
  FSamplerHandle.Free;
  FImage.Free;
  inherited Destroy;
end;

procedure TgxTexture.Assign(Source: TPersistent);
begin
  if Assigned(Source) then
  begin
    if (Source is TgxTexture) then
    begin
      if Source <> Self then
      begin
        FImageAlpha := TgxTexture(Source).FImageAlpha;
        FTextureMode := TgxTexture(Source).FTextureMode;
        FTextureWrap := TgxTexture(Source).FTextureWrap;
        FTextureFormat := TgxTexture(Source).FTextureFormat;
        FCompression := TgxTexture(Source).FCompression;
        FMinFilter := TgxTexture(Source).FMinFilter;
        FMagFilter := TgxTexture(Source).FMagFilter;
        FMappingMode := TgxTexture(Source).FMappingMode;
        MappingSCoordinates.Assign(TgxTexture(Source).MappingSCoordinates);
        MappingTCoordinates.Assign(TgxTexture(Source).MappingTCoordinates);
        MappingRCoordinates.Assign(TgxTexture(Source).MappingRCoordinates);
        MappingQCoordinates.Assign(TgxTexture(Source).MappingQCoordinates);
        FDisabled := TgxTexture(Source).FDisabled;
        SetImage(TgxTexture(Source).FImage);
        FImageBrightness := TgxTexture(Source).FImageBrightness;
        FImageGamma := TgxTexture(Source).FImageGamma;
        FFilteringQuality := TgxTexture(Source).FFilteringQuality;
        FEnvColor.Assign(TgxTexture(Source).FEnvColor);
        FBorderColor.Assign(TgxTexture(Source).FBorderColor);
        FNormalMapScale := TgxTexture(Source).FNormalMapScale;
        // Probably don't need to assign these....
        // FOnTextureNeeded := TgxTexture(Source).FImageGamma;
        // FRequiredMemorySize  : Integer;
        // FTexWidth, FTexHeight : Integer;
        FTextureHandle.NotifyChangesOfData;
        FSamplerHandle.NotifyChangesOfData;
      end;
    end
    else if (Source is TBitmap) then
      Image.Assign(Source)
    else if (Source is TImage) then
      Image.Assign(TImage(Source).Bitmap)
    else
      inherited Assign(Source);
  end
  else
  begin
    FDisabled := True;
    SetImage(nil);
    FTextureHandle.NotifyChangesOfData;
    FSamplerHandle.NotifyChangesOfData;
  end;
end;

procedure TgxTexture.NotifyChange(Sender: TObject);
begin
  if Assigned(Owner) then
  begin
    if Owner is TgxTextureExItem then
      TgxTextureExItem(Owner).NotifyChange(Self);
  end;
  if Sender is TgxTextureImage then
    FTextureHandle.NotifyChangesOfData;

  inherited;
end;

procedure TgxTexture.NotifyImageChange;
begin
  FTextureHandle.NotifyChangesOfData;
  NotifyChange(Self);
end;

procedure TgxTexture.NotifyParamsChange;
begin
  FSamplerHandle.NotifyChangesOfData;
  NotifyChange(Self);
end;

procedure TgxTexture.SetImage(AValue: TgxTextureImage);
begin
  if Assigned(aValue) then
  begin
    if FImage.ClassType <> AValue.ClassType then
    begin
      FImage.Free;
      FImage := TgxTextureImageClass(AValue.ClassType).Create(Self);
      FImage.OnTextureNeeded := DoOnTextureNeeded;
    end;
    FImage.Assign(AValue);
  end
  else
  begin
    FImage.Free;
    FImage := TgxPersistentImage.Create(Self);
    FImage.OnTextureNeeded := DoOnTextureNeeded;
  end;
end;

procedure TgxTexture.SetImageClassName(const val: string);
var
  newImage: TgxTextureImage;
  newImageClass: TgxTextureImageClass;
begin
  if val <> '' then
    if FImage.ClassName <> val then
    begin
      newImageClass := FindTextureImageClass(val);
      Assert(newImageClass <> nil, 'Make sure you include the unit for ' + val +
        ' in your uses clause');
      if newImageClass = nil then
        exit;
      newImage := newImageClass.Create(Self);
      newImage.OnTextureNeeded := DoOnTextureNeeded;
      FImage.Free;
      FImage := newImage;
    end;
end;

function TgxTexture.GetImageClassName: string;
begin
  Result := FImage.ClassName;
end;

function TgxTexture.TextureImageRequiredMemory: Integer;
var
  w, h, e, levelSize: Integer;
begin
  if FRequiredMemorySize < 0 then
  begin
    if IsCompressedFormat(fTextureFormat) then
    begin
      w := (Image.Width + 3) div 4;
      h := (Image.Height + 3) div 4;
    end
    else
    begin
      w := Image.Width;
      h := Image.Height;
    end;

    e := GetTextureElementSize(fTextureFormat);
    FRequiredMemorySize := w * h * e;
    if Image.Depth > 0 then
      FRequiredMemorySize := FRequiredMemorySize * Image.Depth;

    if not (MinFilter in [miNearest, miLinear]) then
    begin
      levelSize := FRequiredMemorySize;
      while e < levelSize do
      begin
        levelSize := levelSize div 4;
        FRequiredMemorySize := FRequiredMemorySize + levelSize;
      end;
    end;

    if Image.NativeTextureTarget = ttTextureCube then
      FRequiredMemorySize := FRequiredMemorySize * 6;
  end;
  Result := FRequiredMemorySize;
end;

procedure TgxTexture.SetImageAlpha(const val: TgxTextureImageAlpha);
begin
  if FImageAlpha <> val then
  begin
    FImageAlpha := val;
    NotifyImageChange;
  end;
end;

procedure TgxTexture.SetImageBrightness(const val: Single);
begin
  if FImageBrightness <> val then
  begin
    FImageBrightness := val;
    NotifyImageChange;
  end;
end;

function TgxTexture.StoreBrightness: Boolean;
begin
  Result := (FImageBrightness <> 1.0);
end;

procedure TgxTexture.SetImageGamma(const val: Single);
begin
  if FImageGamma <> val then
  begin
    FImageGamma := val;
    NotifyImageChange;
  end;
end;

function TgxTexture.StoreGamma: Boolean;
begin
  Result := (FImageGamma <> 1.0);
end;

procedure TgxTexture.SetMagFilter(AValue: TgxMagFilter);
begin
  if AValue <> FMagFilter then
  begin
    FMagFilter := AValue;
    NotifyParamsChange;
  end;
end;

procedure TgxTexture.SetMinFilter(AValue: TgxMinFilter);
begin
  if AValue <> FMinFilter then
  begin
    FMinFilter := AValue;
    NotifyParamsChange;
  end;
end;

procedure TgxTexture.SetTextureMode(AValue: TgxTextureMode);
begin
  if AValue <> FTextureMode then
  begin
    FTextureMode := AValue;
    NotifyParamsChange;
  end;
end;

procedure TgxTexture.SetDisabled(AValue: Boolean);
var
  intf: IgxTextureNotifyAble;
begin
  if AValue <> FDisabled then
  begin
    FDisabled := AValue;
    if Supports(Owner, IgxTextureNotifyAble, intf) then
      intf.NotifyTexMapChange(Self)
    else
      NotifyChange(Self);
  end;
end;

procedure TgxTexture.SetEnabled(const val: Boolean);
begin
  Disabled := not val;
end;

function TgxTexture.GetEnabled: Boolean;
begin
  Result := not Disabled;
end;

procedure TgxTexture.SetEnvColor(const val: TgxColor);
begin
  FEnvColor.Assign(val);
  NotifyParamsChange;
end;

procedure TgxTexture.SetBorderColor(const val: TgxColor);
begin
  FBorderColor.Assign(val);
  NotifyParamsChange;
end;

procedure TgxTexture.SetNormalMapScale(const val: Single);
begin
  if val <> FNormalMapScale then
  begin
    FNormalMapScale := val;
    if TextureFormat = tfNormalMap then
      NotifyImageChange;
  end;
end;

function TgxTexture.StoreNormalMapScale: Boolean;
begin
  Result := (FNormalMapScale <> cDefaultNormalMapScale);
end;

procedure TgxTexture.SetTextureWrap(AValue: TgxTextureWrap);
begin
  if AValue <> FTextureWrap then
  begin
    FTextureWrap := AValue;
    NotifyParamsChange;
  end;
end;

procedure TgxTexture.SetTextureWrapS(AValue: TglSeparateTextureWrap);
begin
  if AValue <> FTextureWrapS then
  begin
    FTextureWrapS := AValue;
    NotifyParamsChange;
  end;
end;

procedure TgxTexture.SetTextureWrapT(AValue: TglSeparateTextureWrap);
begin
  if AValue <> FTextureWrapT then
  begin
    FTextureWrapT := AValue;
    NotifyParamsChange;
  end;
end;

procedure TgxTexture.SetTextureWrapR(AValue: TglSeparateTextureWrap);
begin
  if AValue <> FTextureWrapR then
  begin
    FTextureWrapR := AValue;
    NotifyParamsChange;
  end;
end;

function TgxTexture.GetTextureFormat: TgxTextureFormat;
var
  i: TgxTextureFormat;
begin
  if vDefaultTextureFormat = FTextureFormat then
  begin
    Result := tfDefault;
    Exit;
  end;
  for i := tfRGB to tfRGBAFloat32 do
  begin
    if cOldTextureFormatToInternalFormat[i] = FTextureFormat then
    begin
      Result := i;
      Exit;
    end;
  end;
  Result := tfExtended;
end;

procedure TgxTexture.SetTextureFormat(const val: TgxTextureFormat);
begin
  if val = tfDefault then
  begin
    FTextureFormat := vDefaultTextureFormat;
  end
  else if val < tfExtended then
  begin
    FTextureFormat := cOldTextureFormatToInternalFormat[val];
  end;
end;

procedure TgxTexture.SetTextureFormatEx(const val: TglInternalFormat);
begin
  if val <> FTextureFormat then
  begin
    FTextureFormat := val;
    NotifyImageChange;
  end;
end;

function TgxTexture.StoreTextureFormatEx: Boolean;
begin
  Result := GetTextureFormat >= tfExtended;
end;

procedure TgxTexture.SetCompression(const val: TgxTextureCompression);
begin
  if val <> FCompression then
  begin
    FCompression := val;
    NotifyParamsChange;
  end;
end;

procedure TgxTexture.SetFilteringQuality(const val: TglTextureFilteringQuality);
begin
  if val <> FFilteringQuality then
  begin
    FFilteringQuality := val;
    NotifyParamsChange;
  end;
end;

procedure TgxTexture.SetMappingMode(const val: TgxTextureMappingMode);
var
  texMapChange: Boolean;
  intf: IgxTextureNotifyAble;
begin
  if val <> FMappingMode then
  begin
    texMapChange := ((val = tmmUser) and (FMappingMode <> tmmUser))
      or ((val = tmmUser) and (FMappingMode <> tmmUser));
    FMappingMode := val;
    if texMapChange then
    begin
      // when switching between texGen modes and user mode, the geometry
      // must be rebuilt in whole (to specify/remove texCoord data!)
      if Supports(Owner, IgxTextureNotifyAble, intf) then
        intf.NotifyTexMapChange(Self);
    end
    else
      NotifyChange(Self);
  end;
end;

procedure TgxTexture.SetMappingSCoordinates(const val: TgxCoordinates4);
begin
  MappingSCoordinates.Assign(val);
end;

function TgxTexture.GetMappingSCoordinates: TgxCoordinates4;
begin
  if not Assigned(FMapSCoordinates) then
    FMapSCoordinates := TgxCoordinates4.CreateInitialized(Self, XHmgVector, csVector);
  Result := FMapSCoordinates;
end;

function TgxTexture.StoreMappingSCoordinates: Boolean;
begin
  if Assigned(FMapSCoordinates) then
    Result := not VectorEquals(FMapSCoordinates.AsVector, XHmgVector)
  else
    Result := false;
end;

procedure TgxTexture.SetMappingTCoordinates(const val: TgxCoordinates4);
begin
  MappingTCoordinates.Assign(val);
end;

function TgxTexture.GetMappingTCoordinates: TgxCoordinates4;
begin
  if not Assigned(FMapTCoordinates) then
    FMapTCoordinates := TgxCoordinates4.CreateInitialized(Self, YHmgVector,
      csVector);
  Result := FMapTCoordinates;
end;

function TgxTexture.StoreMappingTCoordinates: Boolean;
begin
  if Assigned(FMapTCoordinates) then
    Result := not VectorEquals(FMapTCoordinates.AsVector, YHmgVector)
  else
    Result := false;
end;

procedure TgxTexture.SetMappingRCoordinates(const val: TgxCoordinates4);
begin
  MappingRCoordinates.Assign(val);
end;

function TgxTexture.GetMappingRCoordinates: TgxCoordinates4;
begin
  if not Assigned(FMapRCoordinates) then
    FMapRCoordinates := TgxCoordinates4.CreateInitialized(Self, ZHmgVector,
      csVector);
  Result := FMapRCoordinates;
end;

function TgxTexture.StoreMappingRCoordinates: Boolean;
begin
  if Assigned(FMapRCoordinates) then
    Result := not VectorEquals(FMapRCoordinates.AsVector, ZHmgVector)
  else
    Result := false;
end;

procedure TgxTexture.SetMappingQCoordinates(const val: TgxCoordinates4);
begin
  MappingQCoordinates.Assign(val);
end;

function TgxTexture.GetMappingQCoordinates: TgxCoordinates4;
begin
  if not Assigned(FMapQCoordinates) then
    FMapQCoordinates := TgxCoordinates4.CreateInitialized(Self, WHmgVector,
      csVector);
  Result := FMapQCoordinates;
end;

function TgxTexture.StoreMappingQCoordinates: Boolean;
begin
  if Assigned(FMapQCoordinates) then
    Result := not VectorEquals(FMapQCoordinates.AsVector, WHmgVector)
  else
    Result := false;
end;

function TgxTexture.StoreImageClassName: Boolean;
begin
  Result := (FImage.ClassName <> TgxPersistentImage.ClassName);
end;

procedure TgxTexture.SetTextureCompareMode(const val: TglTextureCompareMode);
begin
  if val <> fTextureCompareMode then
  begin
    fTextureCompareMode := val;
    NotifyParamsChange;
  end;
end;

procedure TgxTexture.SetTextureCompareFunc(const val: TgxDepthCompareFunc);
begin
  if val <> fTextureCompareFunc then
  begin
    fTextureCompareFunc := val;
    NotifyParamsChange;
  end;
end;

procedure TgxTexture.SetDepthTextureMode(const val: TgxDepthTextureMode);
begin
  if val <> fDepthTextureMode then
  begin
    fDepthTextureMode := val;
    NotifyParamsChange;
  end;
end;

procedure TgxTexture.PrepareBuildList;
begin
  GetHandle;
end;

procedure TgxTexture.ApplyMappingMode;
begin
  case MappingMode of
    tmmUser: ; // nothing to do, but checked first (common case)
    tmmObjectLinear:
      begin
        glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR);
        glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR);
        glTexGenfv(GL_S, GL_OBJECT_PLANE, @MappingSCoordinates.DirectVector);
        glTexGenfv(GL_T, GL_OBJECT_PLANE, @MappingTCoordinates.DirectVector);
        glEnable(GL_TEXTURE_GEN_S);
        glEnable(GL_TEXTURE_GEN_T);

        /// if GL_TEXTURE_CUBE_MAP or GL_TEXTURE_3D then
        begin
          glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR);
          glTexGeni(GL_Q, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR);
          glTexGenfv(GL_R, GL_OBJECT_PLANE, @MappingRCoordinates.DirectVector);
          glTexGenfv(GL_Q, GL_OBJECT_PLANE, @MappingQCoordinates.DirectVector);
          glEnable(GL_TEXTURE_GEN_R);
          glEnable(GL_TEXTURE_GEN_Q);
        end;
      end;
    tmmEyeLinear:
      begin
        glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
        glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
        // specify planes in eye space, not world space
        glMatrixMode(GL_MODELVIEW);
        glPushMatrix;
        glLoadIdentity;
        glTexGenfv(GL_S, GL_EYE_PLANE, @MappingSCoordinates.DirectVector);
        glTexGenfv(GL_T, GL_EYE_PLANE, @MappingTCoordinates.DirectVector);
        glEnable(GL_TEXTURE_GEN_S);
        glEnable(GL_TEXTURE_GEN_T);
        /// if GL_TEXTURE_CUBE_MAP or GL_TEXTURE_3D then
        begin
          glTexGenfv(GL_R, GL_EYE_PLANE, @MappingRCoordinates.DirectVector);
          glTexGenfv(GL_Q, GL_EYE_PLANE, @MappingQCoordinates.DirectVector);
          glEnable(GL_TEXTURE_GEN_R);
          glEnable(GL_TEXTURE_GEN_Q);
        end;
        glPopMatrix;
      end;
    tmmSphere:
      begin
        glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP);
        glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP);
        glEnable(GL_TEXTURE_GEN_S);
        glEnable(GL_TEXTURE_GEN_T);
      end;
    tmmCubeMapReflection, tmmCubeMapCamera:
    /// if GL_TEXTURE_CUBE_MAP then
      begin
        glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP);
        glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP);
        glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP);
        glEnable(GL_TEXTURE_GEN_S);
        glEnable(GL_TEXTURE_GEN_T);
        glEnable(GL_TEXTURE_GEN_R);
      end;
    tmmCubeMapNormal, tmmCubeMapLight0:
    /// if GL_TEXTURE_CUBE_MAP then
      begin
        glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_NORMAL_MAP);
        glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_NORMAL_MAP);
        glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, GL_NORMAL_MAP);
        glEnable(GL_TEXTURE_GEN_S);
        glEnable(GL_TEXTURE_GEN_T);
        glEnable(GL_TEXTURE_GEN_R);
      end;
  else
    Assert(False);
  end;
end;

procedure TgxTexture.UnApplyMappingMode;
begin
  if MappingMode <> tmmUser then
  begin
    glDisable(GL_TEXTURE_GEN_S);
    glDisable(GL_TEXTURE_GEN_T);
    /// if GL_TEXTURE_3D or GL_TEXTURE_CUBE_MAP then
    begin
      glDisable(GL_TEXTURE_GEN_R);
      glDisable(GL_TEXTURE_GEN_Q);
    end;
  end;
end;

procedure TgxTexture.Apply(var rci: TgxRenderContextInfo);

  procedure SetCubeMapTextureMatrix;
  var
    m, mm: TMatrix4f;
  begin
    // compute model view matrix for proper viewing
    case MappingMode of
      tmmCubeMapReflection, tmmCubeMapNormal:
        begin
          m := rci.PipelineTransformation.ViewMatrix^;
          NormalizeMatrix(m);
          TransposeMatrix(m);
          rci.gxStates.SetTextureMatrix(m);
        end;
      tmmCubeMapLight0:
        begin
          with TgxScene(rci.scene).Lights do
            if Count > 0 then
            begin
              m := TgxLightSource(Items[0]).AbsoluteMatrix;
              NormalizeMatrix(m);
              mm := rci.PipelineTransformation.ViewMatrix^;
              NormalizeMatrix(mm);
              TransposeMatrix(mm);
              m := MatrixMultiply(m, mm);
              rci.gxStates.SetTextureMatrix(m);
            end;
        end;
      tmmCubeMapCamera:
        begin
          m.X := VectorCrossProduct(rci.cameraUp, rci.cameraDirection);
          m.Y := VectorNegate(rci.cameraDirection);
          m.Z := rci.cameraUp;
          m.W := WHmgPoint;
          mm := rci.PipelineTransformation.ViewMatrix^;
          NormalizeMatrix(mm);
          TransposeMatrix(mm);
          m := MatrixMultiply(m, mm);
          rci.gxStates.SetTextureMatrix(m);
        end;
    end;
  end;
var
  H : Cardinal;
begin
  // Multisample image do not work with FFP
  if (FTextureHandle.Target = ttTexture2DMultisample) or
    (FTextureHandle.Target = ttTexture2DMultisampleArray) then
    exit;

  H := Handle;
  if not Disabled and (H > 0) then
  begin
    with rci.gxStates do
    begin
      ActiveTexture := 0;
      TextureBinding[0, FTextureHandle.Target] := H;
      ActiveTextureEnabled[FTextureHandle.Target] := True;
    end;

    if not rci.gxStates.ForwardContext then
    begin
      if FTextureHandle.Target = ttTextureCube then
        SetCubeMapTextureMatrix;
      glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE,
        cTextureMode[FTextureMode]);
      glTexEnvfv(GL_TEXTURE_ENV, GL_TEXTURE_ENV_COLOR, FEnvColor.AsAddress);
      ApplyMappingMode;
      xglMapTexCoordToMain;
    end;
  end
  else if not rci.gxStates.ForwardContext then
  begin // default
    xglMapTexCoordToMain;
  end;
end;

procedure TgxTexture.UnApply(var rci: TgxRenderContextInfo);
begin
  if not Disabled
    and not rci.gxStates.ForwardContext then
  begin
    // Multisample image do not work with FFP
    if FTextureHandle.Target in [ttNoShape, ttTexture2DMultisample, ttTexture2DMultisampleArray] then
      exit;
    with rci.gxStates do
    begin
      ActiveTexture := 0;
      ActiveTextureEnabled[FTextureHandle.Target] := False;
      if FTextureHandle.Target = ttTextureCube then
        ResetTextureMatrix;
    end;
    UnApplyMappingMode;
  end;
end;

procedure TgxTexture.ApplyAsTexture2(var rci: TgxRenderContextInfo; textureMatrix:
  PMatrix4f = nil);
begin
  ApplyAsTextureN(2, rci, textureMatrix);
end;

procedure TgxTexture.UnApplyAsTexture2(var rci: TgxRenderContextInfo;
  reloadIdentityTextureMatrix: boolean);
begin
  UnApplyAsTextureN(2, rci, reloadIdentityTextureMatrix);
end;

procedure TgxTexture.ApplyAsTextureN(n: Integer; var rci: TgxRenderContextInfo;
  textureMatrix: PMatrix4f = nil);
var
  m: TMatrix4f;
begin
  if not Disabled then
  begin
    // Multisample image do not work with FFP
    if (FTextureHandle.Target = ttTexture2DMultisample) or
      (FTextureHandle.Target = ttTexture2DMultisampleArray) then
      exit;
    with rci.gxStates do
    begin
      ActiveTexture := n - 1;
      TextureBinding[n - 1, FTextureHandle.Target] := Handle;
      ActiveTextureEnabled[FTextureHandle.Target] := True;
      if Assigned(textureMatrix) then
        SetTextureMatrix(textureMatrix^)
      else if FTextureHandle.Target = ttTextureCube then
      begin
        m := rci.PipelineTransformation.ModelViewMatrix^;
        NormalizeMatrix(m);
        TransposeMatrix(m);
        rci.gxStates.SetTextureMatrix(m);
      end;

      if not ForwardContext then
      begin
        glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, cTextureMode[FTextureMode]);
        glTexEnvfv(GL_TEXTURE_ENV, GL_TEXTURE_ENV_COLOR, FEnvColor.AsAddress);
        ApplyMappingMode;
        ActiveTexture := 0;
      end;
    end;
  end;
end;

procedure TgxTexture.UnApplyAsTextureN(n: Integer; var rci: TgxRenderContextInfo;
  reloadIdentityTextureMatrix: boolean);
begin
  if not rci.gxStates.ForwardContext then
  begin
    // Multisample image do not work with FFP
    if (FTextureHandle.Target = ttTexture2DMultisample) or
      (FTextureHandle.Target = ttTexture2DMultisampleArray) then
      exit;
    with rci.gxStates do
    begin
      ActiveTexture := n - 1;
      ActiveTextureEnabled[FTextureHandle.Target] := False;
      UnApplyMappingMode;
      if (FTextureHandle.Target = ttTextureCube) or reloadIdentityTextureMatrix then
        ResetTextureMatrix;
      ActiveTexture := 0;
    end;
  end;
end;

function TgxTexture.AllocateHandle: Cardinal;
var
  vTarget: TglTextureTarget;
begin
  vTarget := Image.NativeTextureTarget;
  if (vTarget <> ttNoShape) and (FTextureHandle.Target <> vTarget) then
    FTextureHandle.DestroyHandle;

  Result := FTextureHandle.Handle;
  if Result = 0 then
  begin
    FTextureHandle.AllocateHandle;
    Result := FTextureHandle.Handle;
  end;
  if FTextureHandle.IsDataNeedUpdate then
  begin
    FTextureHandle.Target := vTarget;
    FSamplerHandle.NotifyChangesOfData;
  end;
  if FSamplerHandle.Handle = 0 then
    FSamplerHandle.AllocateHandle;

  // bind texture
  if (FTextureHandle.Target <> ttNoShape) and
    IsTargetSupported(FTextureHandle.Target) then
  begin
    if FSamplerHandle.IsDataNeedUpdate then
    begin
      with CurrentContext.gxStates do
        TextureBinding[ActiveTexture, FTextureHandle.Target] := Result;
      PrepareParams(DecodeTextureTarget(FTextureHandle.Target));
      FSamplerHandle.NotifyDataUpdated;
    end;
  end
  else
    Result := 0;
end;

function TgxTexture.IsHandleAllocated: Boolean;
begin
  Result := (FTextureHandle.Handle <> 0);
end;

function TgxTexture.GetHandle: Cardinal;
var
  target: Cardinal;
  LBinding: array[TglTextureTarget] of Cardinal;

  procedure StoreBindings;
  var
    t: TglTextureTarget;
  begin
    with CurrentContext.gxStates do
    begin
      if TextureBinding[ActiveTexture, FTextureHandle.Target] = FTextureHandle.Handle then
        TextureBinding[ActiveTexture, FTextureHandle.Target] := 0;
      for t := Low(TglTextureTarget) to High(TglTextureTarget) do
        LBinding[t] := TextureBinding[ActiveTexture, t];
    end;
  end;
  procedure RestoreBindings;
  var
    t: TglTextureTarget;
  begin
    with CurrentContext.gxStates do
      for t := Low(TglTextureTarget) to High(TglTextureTarget) do
        TextureBinding[ActiveTexture, t] := LBinding[t];
  end;

begin
  with CurrentContext.gxStates do
  begin
    StoreBindings;
    try
      Result := AllocateHandle;
      if FTextureHandle.IsDataNeedUpdate then
      begin
        FTextureHandle.NotifyDataUpdated;
        // Check supporting
        target := DecodeTextureTarget(Image.NativeTextureTarget);
        if not IsTargetSupported(target)
          or not IsFormatSupported(TextureFormatEx) then
        begin
          SetTextureErrorImage;
          target := GL_TEXTURE_2D;
        end;
        // Load images
        // if not GL_EXT_direct_state_access then
        TextureBinding[ActiveTexture, FTextureHandle.Target] := Result;
        PrepareImage(target);
      end;
    finally
      RestoreBindings;
    end;
  end;
end;

procedure TgxTexture.DestroyHandles;
begin
  FTextureHandle.DestroyHandle;
  FSamplerHandle.DestroyHandle;
  FRequiredMemorySize := -1;
end;

function TgxTexture.IsFloatType: Boolean;
begin
  Result := IsFloatFormat(TextureFormatEx);
end;

function TgxTexture.OpenGLTextureFormat: Integer;
var
  texComp: TgxTextureCompression;

begin
  if GL_TEXTURE_COMPRESSION_HINT > 0 then ///
  begin
    if Compression = tcDefault then
      if vDefaultTextureCompression = tcDefault then
        texComp := tcNone
      else
        texComp := vDefaultTextureCompression
    else
      texComp := Compression;
  end
  else
    texComp := tcNone;

  if IsFloatType then
    texComp := tcNone; // no compression support for float_type

  if (texComp <> tcNone) and (TextureFormat <= tfNormalMap) then
    with CurrentContext.gxStates do
    begin
      case texComp of
        tcStandard: TextureCompressionHint := hintDontCare;
        tcHighQuality: TextureCompressionHint := hintNicest;
        tcHighSpeed: TextureCompressionHint := hintFastest;
      else
        Assert(False);
      end;
      Result := CompressedInternalFormatToOpenGL(TextureFormatEx);
    end
  else
    Result := InternalFormatToOpenGLFormat(TextureFormatEx);
end;

procedure TgxTexture.PrepareImage(target: Cardinal);
var
  bitmap32: TgxImage;
  texComp: TgxTextureCompression;
  glFormat: Cardinal;
begin
  if Image.IsSelfLoading then
  begin
    Image.LoadTexture(FTextureFormat);
  end
  else
  begin

    bitmap32 := Image.GetBitmap32;

    if (bitmap32 = nil) or bitmap32.IsEmpty then
      Exit;

    if TextureFormat = tfNormalMap then
      bitmap32.GrayScaleToNormalMap(NormalMapScale,
        TextureWrap in [twBoth, twHorizontal],
        TextureWrap in [twBoth, twVertical]);
    // prepare AlphaChannel
    case ImageAlpha of
      tiaDefault: ; // nothing to do
      tiaAlphaFromIntensity:
        bitmap32.SetAlphaFromIntensity;
      tiaSuperBlackTransparent:
        bitmap32.SetAlphaTransparentForColor($000000);
      tiaLuminance:
        bitmap32.SetAlphaFromIntensity;
      tiaLuminanceSqrt:
        begin
          bitmap32.SetAlphaFromIntensity;
          bitmap32.SqrtAlpha;
        end;
      tiaOpaque:
        bitmap32.SetAlphaToValue(255);
      tiaTopLeftPointColorTransparent:
        begin
          bitmap32.Narrow;
          bitmap32.SetAlphaTransparentForColor(bitmap32.Data^[0]);
        end;
      tiaInverseLuminance:
        begin
          bitmap32.SetAlphaFromIntensity;
          bitmap32.InvertAlpha;
        end;
      tiaInverseLuminanceSqrt:
        begin
          bitmap32.SetAlphaFromIntensity;
          bitmap32.SqrtAlpha;
          bitmap32.InvertAlpha;
        end;
      tiaBottomRightPointColorTransparent:
        begin
          bitmap32.Narrow;
          bitmap32.SetAlphaTransparentForColor(bitmap32.Data^[bitmap32.Width - 1]);
        end;
    else
      Assert(False);
    end;
    // apply brightness correction
    if FImageBrightness <> 1.0 then
      bitmap32.BrightnessCorrection(FImageBrightness);
    // apply gamma correction
    if FImageGamma <> 1.0 then
      bitmap32.GammaCorrection(FImageGamma);

    if /// GL_ARB_texture_compression and
    (TextureFormat <> tfExtended) then
    begin
      if Compression = tcDefault then
        if vDefaultTextureCompression = tcDefault then
          texComp := tcNone
        else
          texComp := vDefaultTextureCompression
      else
        texComp := Compression;
      if IsFloatType then
        texComp := tcNone;

    end
    else
      texComp := tcNone;

    if (texComp <> tcNone) and (TextureFormat <= tfNormalMap) then
      with CurrentContext.gxStates do
      begin
        case texComp of
          tcStandard: TextureCompressionHint := hintDontCare;
          tcHighQuality: TextureCompressionHint := hintNicest;
          tcHighSpeed: TextureCompressionHint := hintFastest;
        else
          Assert(False, strErrorEx + strUnknownType);
        end;
        glFormat := CompressedInternalFormatToOpenGL(FTextureFormat);
      end
    else
      glFormat := InternalFormatToOpenGLFormat(FTextureFormat);

    bitmap32.RegisterAsOpenRXTexture(
      FTextureHandle,
      not (FMinFilter in [miNearest, miLinear]),
      glFormat,
      FTexWidth,
      FTexHeight,
      FTexDepth);
  end;

  if glGetError <> GL_NO_ERROR then
  begin
    SetTextureErrorImage;
  end
  else
  begin
    FRequiredMemorySize := -1;
    TextureImageRequiredMemory;
    if not IsDesignTime and not FKeepImageAfterTransfer then
      Image.ReleaseBitmap32;
  end;
end;

procedure TgxTexture.PrepareParams(target: Cardinal);
const
  cTextureSWrap: array[twBoth..twHorizontal] of Cardinal =
    (GL_REPEAT, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_REPEAT);
  cTextureTWrap: array[twBoth..twHorizontal] of Cardinal =
    (GL_REPEAT, GL_CLAMP_TO_EDGE, GL_REPEAT, GL_CLAMP_TO_EDGE);
  cTextureRWrap: array[twBoth..twHorizontal] of Cardinal =
    (GL_REPEAT, GL_CLAMP_TO_EDGE, GL_REPEAT, GL_CLAMP_TO_EDGE);
  cTextureSWrapOld: array[twBoth..twHorizontal] of Cardinal =
    (GL_REPEAT, GL_CLAMP, GL_CLAMP, GL_REPEAT);
  cTextureTWrapOld: array[twBoth..twHorizontal] of Cardinal =
    (GL_REPEAT, GL_CLAMP, GL_REPEAT, GL_CLAMP);
  cTextureMagFilter: array[maNearest..maLinear] of Cardinal =
    (GL_NEAREST, GL_LINEAR);
  cTextureMinFilter: array[miNearest..miLinearMipmapLinear] of Cardinal =
    (GL_NEAREST, GL_LINEAR, GL_NEAREST_MIPMAP_NEAREST,
    GL_LINEAR_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR,
    GL_LINEAR_MIPMAP_LINEAR);
  cFilteringQuality: array[tfIsotropic..tfAnisotropic] of Integer = (1, 2);
  cSeparateTextureWrap: array[twRepeat..twMirrorClampToBorder] of Cardinal =
    (GL_REPEAT, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_BORDER,
    GL_MIRRORED_REPEAT, GL_MIRROR_CLAMP_TO_EDGE_ATI, GL_MIRROR_CLAMP_TO_BORDER_EXT);
  cTextureCompareMode: array[tcmNone..tcmCompareRtoTexture] of Cardinal =
    (GL_NONE, GL_COMPARE_R_TO_TEXTURE);
  cDepthTextureMode: array[dtmLuminance..dtmAlpha] of Cardinal =
    (GL_LUMINANCE, GL_INTENSITY, GL_ALPHA);

var
  lMinFilter: TgxMinFilter;
begin
  if (target = GL_TEXTURE_2D_MULTISAMPLE)
    or (target = GL_TEXTURE_2D_MULTISAMPLE_ARRAY) then
    Exit;

  with CurrentContext.gxStates do
  begin
    UnpackAlignment := 1;
    UnpackRowLength := 0;
    UnpackSkipRows := 0;
    UnpackSkipPixels := 0;
  end;

  glTexParameterfv(target, GL_TEXTURE_BORDER_COLOR, FBorderColor.AsAddress);

  /// if (GL_VERSION_1_2 or GL_texture_edge_clamp) then
  begin
    if FTextureWrap = twSeparate then
    begin
      glTexParameteri(target, GL_TEXTURE_WRAP_S,
        cSeparateTextureWrap[FTextureWrapS]);
      glTexParameteri(target, GL_TEXTURE_WRAP_T,
        cSeparateTextureWrap[FTextureWrapT]);
      if (target = GL_TEXTURE_3D) then ///
        glTexParameteri(target, GL_TEXTURE_WRAP_R,
          cSeparateTextureWrap[FTextureWrapR]);
    end
    else
    begin
      glTexParameteri(target, GL_TEXTURE_WRAP_S, cTextureSWrap[FTextureWrap]);
      glTexParameteri(target, GL_TEXTURE_WRAP_T, cTextureTWrap[FTextureWrap]);
      /// if R_Dim then
        glTexParameteri(target, GL_TEXTURE_WRAP_R, cTextureRWrap[FTextureWrap]);
    end;
  end;
(*
  else
  begin
    glTexParameteri(target, GL_TEXTURE_WRAP_S, cTextureSWrapOld[FTextureWrap]);
    glTexParameteri(target, GL_TEXTURE_WRAP_T, cTextureTWrapOld[FTextureWrap]);
  end;
*)
  lMinFilter := FMinFilter;
  // Down paramenter to rectangular texture supported
  if (target = GL_TEXTURE_RECTANGLE)
  /// or not (GL_EXT_texture_lod_bias or GL_SGIS_texture_lod)
  then
  begin
    if lMinFilter in [miNearestMipmapNearest, miNearestMipmapLinear] then
      lMinFilter := miNearest;
    if FMinFilter in [miLinearMipmapNearest, miLinearMipmapLinear] then
      lMinFilter := miLinear;
  end;

  glTexParameteri(target, GL_TEXTURE_MIN_FILTER, cTextureMinFilter[lMinFilter]);
  glTexParameteri(target, GL_TEXTURE_MAG_FILTER, cTextureMagFilter[FMagFilter]);

  /// if GL_EXT_texture_filter_anisotropic then
    glTexParameteri(target, GL_TEXTURE_MAX_ANISOTROPY_EXT,
      cFilteringQuality[FFilteringQuality]);

  if IsDepthFormat(fTextureFormat) then
  begin
    glTexParameteri(target, GL_TEXTURE_COMPARE_MODE,
      cTextureCompareMode[fTextureCompareMode]);
    glTexParameteri(target, GL_TEXTURE_COMPARE_FUNC,
      cGLComparisonFunctionToGLEnum[fTextureCompareFunc]);
   /// if not FTextureHandle.RenderingContext.gxStates.ForwardContext then
      glTexParameteri(target, GL_DEPTH_TEXTURE_MODE,
        cDepthTextureMode[fDepthTextureMode]);
  end;
end;

procedure TgxTexture.DoOnTextureNeeded(Sender: TObject; var textureFileName:
  string);
begin
  if Assigned(FOnTextureNeeded) then
    FOnTextureNeeded(Sender, textureFileName);
end;

procedure TgxTexture.OnSamplerAllocate(Sender: TgxVirtualHandle; var Handle: Cardinal);
begin
  Handle := 1;
end;

procedure TgxTexture.OnSamplerDestroy(Sender: TgxVirtualHandle; var Handle: Cardinal);
begin
  Handle := 0;
end;

procedure TgxTexture.SetTextureErrorImage;
var
  img: TgxImage;
begin
  img := TgxImage.Create;
  img.SetErrorImage;

  ImageClassName := TgxBlankImage.className;
  TgxBlankImage(Image).Assign(img);
  img.Free;

  MagFilter := maNearest;
  MinFilter := miNearest;
  TextureWrap := twBoth;
  MappingMode := tmmUser;
  Compression := tcNone;
  AllocateHandle;
end;


// ---------------
// --------------- TgxTextureExItem ---------------
// ---------------

constructor TgxTextureExItem.Create(ACollection: TCollection);
begin
  inherited;

  FTexture := TgxTexture.Create(Self);
  FTextureOffset := TgxCoordinates.CreateInitialized(Self, NullHMGVector,
    csPoint);
  FTextureOffset.OnNotifyChange := OnNotifyChange;
  FTextureScale := TgxCoordinates.CreateInitialized(Self, XYZHmgVector,
    csPoint);
  FTextureScale.OnNotifyChange := OnNotifyChange;

  FTextureIndex := ID;
  FTextureMatrix := IdentityHMGMatrix;

  // not very flexible code, assumes it's owned by a material,
  // that has a Texture property, but may need to re-implement it somehow
  (*
    if ACollection is TgxTextureEx then
    if TgxTextureEx(ACollection).FOwner <> nil then
      FTexture.OnTextureNeeded := TgxTextureEx(ACollection).FOwner.Texture.OnTextureNeeded;
   *)
end;

destructor TgxTextureExItem.Destroy;
begin
  FTexture.Free;
  FTextureOffset.Free;
  FTextureScale.Free;

  inherited;
end;


function TgxTextureExItem.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;

function TgxTextureExItem._AddRef: Integer; stdcall;
begin
  Result := -1; //ignore
end;

function TgxTextureExItem._Release: Integer; stdcall;
begin
  Result := -1; //ignore
end;

procedure TgxTextureExItem.Assign(Source: TPersistent);
begin
  if Source is TgxTextureExItem then
  begin
    Texture := TgxTextureExItem(Source).Texture;
    TextureIndex := TgxTextureExItem(Source).TextureIndex;
    TextureOffset := TgxTextureExItem(Source).TextureOffset;
    TextureScale := TgxTextureExItem(Source).TextureScale;
    NotifyChange(Self);
  end
  else
    inherited;
end;

procedure TgxTextureExItem.NotifyChange(Sender: TObject);
begin
  if Assigned(Collection) then
    TgxTextureEx(Collection).NotifyChange(Self);
end;

procedure TgxTextureExItem.Apply(var rci: TgxRenderContextInfo);
begin
  FApplied := False;
  if FTexture.Enabled then
  begin
    rci.gxStates.ActiveTexture := FTextureIndex;
    glMatrixMode(GL_TEXTURE);
    glPushMatrix;
    if FTextureMatrixIsIdentity then
      glLoadIdentity
    else
      glLoadMatrixf(@FTextureMatrix.X.X);
    glMatrixMode(GL_MODELVIEW);
    rci.gxStates.ActiveTexture := 0;
    if FTextureIndex = 0 then
      FTexture.Apply(rci)
    else if FTextureIndex = 1 then
      FTexture.ApplyAsTexture2(rci, nil)
    else if FTextureIndex >= 2 then
      FTexture.ApplyAsTextureN(FTextureIndex + 1, rci, nil);
    FApplied := True;
  end;
end;

procedure TgxTextureExItem.UnApply(var rci: TgxRenderContextInfo);
begin
  if FApplied then
  begin
    if FTextureIndex = 0 then
      FTexture.UnApply(rci)
    else if FTextureIndex = 1 then
      FTexture.UnApplyAsTexture2(rci, false)
    else if FTextureIndex >= 2 then
      FTexture.UnApplyAsTextureN(FTextureIndex + 1, rci, false);
    rci.gxStates.ActiveTexture := FTextureIndex;
    glMatrixMode(GL_TEXTURE);
    glPopMatrix;
    glMatrixMode(GL_MODELVIEW);
    rci.gxStates.ActiveTexture := 0;
    FApplied := False;
  end;
end;

function TgxTextureExItem.GetDisplayName: string;
begin
  Result := Format('Tex [%d]', [FTextureIndex]);
end;

function TgxTextureExItem.GetOwner: TPersistent;
begin
  Result := Collection;
end;

procedure TgxTextureExItem.NotifyTexMapChange(Sender: TObject);
var
  intf: IgxTextureNotifyAble;
begin
  if Supports(TObject(TgxTextureEx(Collection).FOwner), IgxTextureNotifyAble,
    intf) then
    intf.NotifyTexMapChange(Sender);
end;

procedure TgxTextureExItem.SetTexture(const Value: TgxTexture);
begin
  FTexture.Assign(Value);
  NotifyChange(Self);
end;

procedure TgxTextureExItem.SetTextureIndex(const Value: Integer);
var
  temp: Integer;
begin
  temp := Value;
  if temp < 0 then
    temp := 0;
  if temp <> FTextureIndex then
  begin
    FTextureIndex := temp;
    NotifyChange(Self);
  end;
end;

procedure TgxTextureExItem.SetTextureOffset(const Value: TgxCoordinates);
begin
  FTextureOffset.Assign(Value);
  NotifyChange(Self);
end;

procedure TgxTextureExItem.SetTextureScale(const Value: TgxCoordinates);
begin
  FTextureScale.Assign(Value);
  NotifyChange(Self);
end;

procedure TgxTextureExItem.CalculateTextureMatrix;
begin
  if TextureOffset.Equals(NullHmgVector) and TextureScale.Equals(XYZHmgVector) then
    FTextureMatrixIsIdentity := True
  else
  begin
    FTextureMatrixIsIdentity := False;
    FTextureMatrix := CreateScaleAndTranslationMatrix(TextureScale.AsVector,
      TextureOffset.AsVector);
  end;
  NotifyChange(Self);
end;

procedure TgxTextureExItem.OnNotifyChange(Sender: TObject);
begin
  CalculateTextureMatrix;
end;

// ---------------
// --------------- TgxTextureEx ---------------
// ---------------

constructor TgxTextureEx.Create(AOwner: TgxUpdateAbleObject);
begin
  inherited Create(TgxTextureExItem);
  FOwner := AOwner;
end;

procedure TgxTextureEx.NotifyChange(Sender: TObject);
begin
  if Assigned(FOwner) then
    FOwner.NotifyChange(Self);
end;

procedure TgxTextureEx.Apply(var rci: TgxRenderContextInfo);
var
  i, texUnits: Integer;
  units: Cardinal;
begin
  /// if not (GL_ARB_multitexture) then exit;

  units := 0;
  glGetIntegeri_v(GL_MAX_TEXTURE_UNITS, 0, @texUnits);
  for i := 0 to Count - 1 do
  begin
    if Items[i].TextureIndex < texUnits then
    begin
      Items[i].Apply(rci);
      if Items[i].FApplied then
        if (Items[i].TextureIndex > 0) and (Items[i].Texture.MappingMode =
          tmmUser) then
          units := units or (1 shl Items[i].TextureIndex);
    end;
  end;
  if units > 0 then
    xglMapTexCoordToArbitraryAdd(units);
end;

procedure TgxTextureEx.UnApply(var rci: TgxRenderContextInfo);
var
  i: Integer;
begin
  /// if not GL_ARB_multitexture then exit;
  for i := 0 to Count - 1 do
    Items[i].UnApply(rci);
end;

function TgxTextureEx.Add: TgxTextureExItem;
begin
  Result := TgxTextureExItem(inherited Add);
end;

procedure TgxTextureEx.Loaded;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    Items[i].CalculateTextureMatrix;
end;

function TgxTextureEx.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TgxTextureEx.SetItems(index: Integer; const Value: TgxTextureExItem);
begin
  inherited SetItem(index, Value);
end;

function TgxTextureEx.GetItems(index: Integer): TgxTextureExItem;
begin
  Result := TgxTextureExItem(inherited GetItem(index));
end;

function TgxTextureEx.IsTextureEnabled(Index: Integer): Boolean;
var
  i: Integer;
begin
  Result := False;
  if Self = nil then
    Exit;
  for i := 0 to Count - 1 do
    if Items[i].TextureIndex = Index then
      Result := Result or Items[i].Texture.Enabled;
end;

// ------------------------------------------------------------------
initialization
// ------------------------------------------------------------------

  RegisterTextureImageClass(TgxBlankImage);
  RegisterTextureImageClass(TgxPersistentImage);
  RegisterTextureImageClass(TgxPicFileImage);
  RegisterTextureImageClass(TgxCubeMapImage);
  RegisterTGraphicClassFileExtension('.bmp', TBitmap);

finalization

  vGxTextureImageClasses.Free;
  vGxTextureImageClasses := nil;

end.