aksdb
/
CentrED
1
0
Fork 0
Code Issues 2 Pull Requests Releases Wiki Activity
CentrED/Imaging/ImagingOpenGL.pas

868 lines
33 KiB
Plaintext
Raw Normal View History

- Initial import from internal repository
2007-12-21 21:31:58 +01:00
{
$Id: ImagingOpenGL.pas 106 2007-10-23 23:03:35Z galfar $
Vampyre Imaging Library
by Marek Mauder
http://imaginglib.sourceforge.net
The contents of this file are used with permission, subject to the Mozilla
Public License Version 1.1 (the "License"); you may not use this file except
in compliance with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.
Alternatively, the contents of this file may be used under the terms of the
GNU Lesser General Public License (the "LGPL License"), in which case the
provisions of the LGPL License are applicable instead of those above.
If you wish to allow use of your version of this file only under the terms
of the LGPL License and not to allow others to use your version of this file
under the MPL, indicate your decision by deleting the provisions above and
replace them with the notice and other provisions required by the LGPL
License. If you do not delete the provisions above, a recipient may use
your version of this file under either the MPL or the LGPL License.
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
}
{ This unit contains functions for loading and saving OpenGL textures
using Imaging and for converting images to textures and vice versa.}
unit ImagingOpenGL;
{$I ImagingOptions.inc}
{ Define this symbol if you want to use dglOpenGL header.}
{ $DEFINE USE_DGL_HEADERS}
interface
uses
SysUtils, Classes, ImagingTypes, Imaging, ImagingFormats,
{$IFDEF USE_DGL_HEADERS}
dglOpenGL,
{$ELSE}
gl, glext,
{$ENDIF}
ImagingUtility;
type
{ Various texture capabilities of installed OpenGL driver.}
TGLTextureCaps = record
MaxTextureSize: LongInt;
PowerOfTwo: Boolean;
DXTCompression: Boolean;
FloatTextures: Boolean;
MaxAnisotropy: LongInt;
MaxSimultaneousTextures: LongInt;
end;
{ Returns texture capabilities of installed OpenGL driver.}
function GetGLTextureCaps(var Caps: TGLTextureCaps): Boolean;
{ Function which can be used to retrieve GL extension functions.}
function GetGLProcAddress(const ProcName: string): Pointer;
{ Returns True if the given GL extension is supported.}
function IsGLExtensionSupported(const Extension: string): Boolean;
{ Returns True if the given image format can be represented as GL texture
format. GLFormat, GLType, and GLInternal are parameters for functions like
glTexImage. Note that GLU functions like gluBuildMipmaps cannot handle some
formats returned by this function (i.e. GL_UNSIGNED_SHORT_5_5_5_1 as GLType).
If you are using compressed or floating-point images make sure that they are
supported by hardware using GetGLTextureCaps, ImageFormatToGL does not
check this.}
function ImageFormatToGL(Format: TImageFormat; var GLFormat: GLenum;
var GLType: GLenum; var GLInternal: GLint): Boolean;
{ All GL textures created by Imaging functions have default parameters set -
that means that no glTexParameter calls are made so default filtering,
wrapping, and other parameters are used. Created textures
are left bound by glBindTexture when function is exited.}
{ Creates GL texture from image in file in format supported by Imaging.
You can use CreatedWidth and Height parameters to query dimensions of created textures
(it could differ from dimensions of source image).}
function LoadGLTextureFromFile(const FileName: string; CreatedWidth: PLongInt = nil;
CreatedHeight: PLongInt = nil): GLuint;
{ Creates GL texture from image in stream in format supported by Imaging.
You can use CreatedWidth and Height parameters to query dimensions of created textures
(it could differ from dimensions of source image).}
function LoadGLTextureFromStream(Stream: TStream; CreatedWidth: PLongInt = nil;
CreatedHeight: PLongInt = nil): GLuint;
{ Creates GL texture from image in memory in format supported by Imaging.
You can use CreatedWidth and Height parameters to query dimensions of created textures
(it could differ from dimensions of source image).}
function LoadGLTextureFromMemory(Data: Pointer; Size: LongInt;
CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): GLuint;
{ Converts TImageData structure to OpenGL texture.
Input images is used as main mipmap level and additional requested
levels are generated from this one. For the details on parameters
look at CreateGLTextureFromMultiImage function.}
function CreateGLTextureFromImage(const Image: TImageData;
Width: LongInt = 0; Height: LongInt = 0; MipMaps: Boolean = True;
OverrideFormat: TImageFormat = ifUnknown; CreatedWidth: PLongInt = nil;
CreatedHeight: PLongInt = nil): GLuint;
{ Converts images in TDymImageDataArray to one OpenGL texture.
Image at index MainLevelIndex in the array is used as main mipmap level and
additional images are used as subsequent levels. If there is not enough images
in array missing levels are automatically generated (and if there is enough images
but they have wrong dimensions or format then they are resized/converted).
If driver supports only power of two sized textures images are resized.
OverrideFormat can be used to convert image into specific format before
it is passed to OpenGL, ifUnknown means no conversion.
If desired texture format is not supported by hardware default
A8R8G8B8 format is used instead for color images and ifGray8 is used
for luminance images. DXTC (S3TC) compressed and floating point textures
are created if supported by hardware.
Width and Height can be used to set size of main mipmap level according
to your needs, Width and Height of 0 mean use width and height of input
image that will become main level mipmap.
MipMaps set to True mean build all possible levels, False means use only level 0.
You can use CreatedWidth and CreatedHeight parameters to query dimensions of
created texture's largest mipmap level (it could differ from dimensions
of source image).}
function CreateGLTextureFromMultiImage(const Images: TDynImageDataArray;
Width: LongInt = 0; Height: LongInt = 0; MipMaps: Boolean = True;
MainLevelIndex: LongInt = 0; OverrideFormat: TImageFormat = ifUnknown;
CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): GLuint;
{ Saves GL texture to file in one of formats supported by Imaging.
Saves all present mipmap levels.}
function SaveGLTextureToFile(const FileName: string; const Texture: GLuint): Boolean;
{ Saves GL texture to stream in one of formats supported by Imaging.
Saves all present mipmap levels.}
function SaveGLTextureToStream(const Ext: string; Stream: TStream; const Texture: GLuint): Boolean;
{ Saves GL texture to memory in one of formats supported by Imaging.
Saves all present mipmap levels.}
function SaveGLTextureToMemory(const Ext: string; Data: Pointer; var Size: LongInt; const Texture: GLuint): Boolean;
{ Converts main level of the GL texture to TImageData strucrue. OverrideFormat
can be used to convert output image to the specified format rather
than use the format taken from GL texture, ifUnknown means no conversion.}
function CreateImageFromGLTexture(const Texture: GLuint;
var Image: TImageData; OverrideFormat: TImageFormat = ifUnknown): Boolean;
{ Converts GL texture to TDynImageDataArray array of images. You can specify
how many mipmap levels of the input texture you want to be converted
(default is all levels). OverrideFormat can be used to convert output images to
the specified format rather than use the format taken from GL texture,
ifUnknown means no conversion.}
function CreateMultiImageFromGLTexture(const Texture: GLuint;
var Images: TDynImageDataArray; MipLevels: LongInt = 0;
OverrideFormat: TImageFormat = ifUnknown): Boolean;
var
{ Standard behaviour of image->texture functions like CreateGLTextureFrom(Multi)Image is:
If graphic card supports non power of 2 textures and image is nonpow2 then
texture is created directly from image.
If graphic card does not support them input image is rescaled (bilinear)
to power of 2 size.
If you set PasteNonPow2ImagesIntoPow2 to True then instead of rescaling, a new
pow2 texture is created and nonpow2 input image is pasted into it
keeping its original size. This could be useful for some 2D stuff
(and its faster than rescaling of course). Note that this is applied
to all rescaling smaller->bigger operations that might ocurr during
image->texture process (usually only pow2/nonpow2 stuff and when you
set custom Width & Height in CreateGLTextureFrom(Multi)Image).}
PasteNonPow2ImagesIntoPow2: Boolean = False;
implementation
const
// cube map consts
GL_TEXTURE_BINDING_CUBE_MAP = $8514;
GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
// texture formats
GL_COLOR_INDEX = $1900;
GL_STENCIL_INDEX = $1901;
GL_DEPTH_COMPONENT = $1902;
GL_RED = $1903;
GL_GREEN = $1904;
GL_BLUE = $1905;
GL_ALPHA = $1906;
GL_RGB = $1907;
GL_RGBA = $1908;
GL_LUMINANCE = $1909;
GL_LUMINANCE_ALPHA = $190A;
GL_BGR_EXT = $80E0;
GL_BGRA_EXT = $80E1;
// texture internal formats
GL_ALPHA4 = $803B;
GL_ALPHA8 = $803C;
GL_ALPHA12 = $803D;
GL_ALPHA16 = $803E;
GL_LUMINANCE4 = $803F;
GL_LUMINANCE8 = $8040;
GL_LUMINANCE12 = $8041;
GL_LUMINANCE16 = $8042;
GL_LUMINANCE4_ALPHA4 = $8043;
GL_LUMINANCE6_ALPHA2 = $8044;
GL_LUMINANCE8_ALPHA8 = $8045;
GL_LUMINANCE12_ALPHA4 = $8046;
GL_LUMINANCE12_ALPHA12 = $8047;
GL_LUMINANCE16_ALPHA16 = $8048;
GL_INTENSITY = $8049;
GL_INTENSITY4 = $804A;
GL_INTENSITY8 = $804B;
GL_INTENSITY12 = $804C;
GL_INTENSITY16 = $804D;
GL_R3_G3_B2 = $2A10;
GL_RGB4 = $804F;
GL_RGB5 = $8050;
GL_RGB8 = $8051;
GL_RGB10 = $8052;
GL_RGB12 = $8053;
GL_RGB16 = $8054;
GL_RGBA2 = $8055;
GL_RGBA4 = $8056;
GL_RGB5_A1 = $8057;
GL_RGBA8 = $8058;
GL_RGB10_A2 = $8059;
GL_RGBA12 = $805A;
GL_RGBA16 = $805B;
// floating point texture formats
GL_RGBA32F_ARB = $8814;
GL_INTENSITY32F_ARB = $8817;
GL_LUMINANCE32F_ARB = $8818;
GL_RGBA16F_ARB = $881A;
GL_INTENSITY16F_ARB = $881D;
GL_LUMINANCE16F_ARB = $881E;
// compressed texture formats
GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
// various GL extension constants
GL_MAX_TEXTURE_UNITS = $84E2;
GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
// texture source data formats
GL_UNSIGNED_BYTE_3_3_2 = $8032;
GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
GL_UNSIGNED_INT_8_8_8_8 = $8035;
GL_UNSIGNED_INT_10_10_10_2 = $8036;
GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
GL_UNSIGNED_SHORT_5_6_5 = $8363;
GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
GL_HALF_FLOAT_ARB = $140B;
{$IFDEF MSWINDOWS}
GLLibName = 'opengl32.dll';
{$ENDIF}
{$IFDEF UNIX}
GLLibName = 'libGL.so';
{$ENDIF}
type
TglCompressedTexImage2D = procedure (Target: GLenum; Level: GLint;
InternalFormat: GLenum; Width: GLsizei; Height: GLsizei; Border: GLint;
ImageSize: GLsizei; const Data: PGLvoid);
{$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
var
glCompressedTexImage2D: TglCompressedTexImage2D = nil;
ExtensionBuffer: string = '';
{$IFDEF MSWINDOWS}
function wglGetProcAddress(ProcName: PChar): Pointer; stdcall; external GLLibName;
{$ENDIF}
{$IFDEF UNIX}
function glXGetProcAddress(ProcName: PChar): Pointer; cdecl; external GLLibName;
{$ENDIF}
function IsGLExtensionSupported(const Extension: string): Boolean;
var
ExtPos: LongInt;
begin
if ExtensionBuffer = '' then
ExtensionBuffer := glGetString(GL_EXTENSIONS);
ExtPos := Pos(Extension, ExtensionBuffer);
Result := ExtPos > 0;
if Result then
begin
Result := ((ExtPos + Length(Extension) - 1) = Length(ExtensionBuffer)) or
not (ExtensionBuffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
end;
end;
function GetGLProcAddress(const ProcName: string): Pointer;
begin
{$IFDEF MSWINDOWS}
Result := wglGetProcAddress(PChar(ProcName));
{$ENDIF}
{$IFDEF UNIX}
Result := glXGetProcAddress(PChar(ProcName));
{$ENDIF}
end;
function GetGLTextureCaps(var Caps: TGLTextureCaps): Boolean;
begin
// check DXTC support and load extension functions if necesary
Caps.DXTCompression := IsGLExtensionSupported('GL_ARB_texture_compression') and
IsGLExtensionSupported('GL_EXT_texture_compression_s3tc');
if Caps.DXTCompression then
glCompressedTexImage2D := GetGLProcAddress('glCompressedTexImage2D');
Caps.DXTCompression := Caps.DXTCompression and (@glCompressedTexImage2D <> nil);
// check non power of 2 textures
Caps.PowerOfTwo := not IsGLExtensionSupported('GL_ARB_texture_non_power_of_two');
// check for floating point textures support
Caps.FloatTextures := IsGLExtensionSupported('GL_ARB_texture_float');
// get max texture size
glGetIntegerv(GL_MAX_TEXTURE_SIZE, @Caps.MaxTextureSize);
// get max anisotropy
if IsGLExtensionSupported('GL_EXT_texture_filter_anisotropic') then
glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @Caps.MaxAnisotropy)
else
Caps.MaxAnisotropy := 0;
// get number of texture units
if IsGLExtensionSupported('GL_ARB_multitexture') then
glGetIntegerv(GL_MAX_TEXTURE_UNITS, @Caps.MaxSimultaneousTextures)
else
Caps.MaxSimultaneousTextures := 1;
// get max texture size
glGetIntegerv(GL_MAX_TEXTURE_SIZE, @Caps.MaxTextureSize);
Result := True;
end;
function ImageFormatToGL(Format: TImageFormat; var GLFormat: GLenum;
var GLType: GLenum; var GLInternal: GLint): Boolean;
begin
GLFormat := 0;
GLType := 0;
GLInternal := 0;
case Format of
// Gray formats
ifGray8, ifGray16:
begin
GLFormat := GL_LUMINANCE;
GLType := Iff(Format = ifGray8, GL_UNSIGNED_BYTE, GL_UNSIGNED_SHORT);
GLInternal := Iff(Format = ifGray8, GL_LUMINANCE8, GL_LUMINANCE16);
end;
ifA8Gray8, ifA16Gray16:
begin
GLFormat := GL_LUMINANCE_ALPHA;
GLType := Iff(Format = ifA8Gray8, GL_UNSIGNED_BYTE, GL_UNSIGNED_SHORT);
GLInternal := Iff(Format = ifA8Gray8, GL_LUMINANCE8_ALPHA8, GL_LUMINANCE16_ALPHA16);
end;
// RGBA formats
ifR3G3B2:
begin
GLFormat := GL_RGB;
GLType := GL_UNSIGNED_BYTE_3_3_2;
GLInternal := GL_R3_G3_B2;
end;
ifR5G6B5:
begin
GLFormat := GL_RGB;
GLType := GL_UNSIGNED_SHORT_5_6_5;
GLInternal := GL_RGB5;
end;
ifA1R5G5B5, ifX1R5G5B5:
begin
GLFormat := GL_BGRA_EXT;
GLType := GL_UNSIGNED_SHORT_1_5_5_5_REV;
GLInternal := Iff(Format = ifA1R5G5B5, GL_RGB5_A1, GL_RGB5);
end;
ifA4R4G4B4, ifX4R4G4B4:
begin
GLFormat := GL_BGRA_EXT;
GLType := GL_UNSIGNED_SHORT_4_4_4_4_REV;
GLInternal := Iff(Format = ifA4R4G4B4, GL_RGBA4, GL_RGB4);
end;
ifR8G8B8:
begin
GLFormat := GL_BGR_EXT;
GLType := GL_UNSIGNED_BYTE;
GLInternal := GL_RGB8;
end;
ifA8R8G8B8, ifX8R8G8B8:
begin
GLFormat := GL_BGRA_EXT;
GLType := GL_UNSIGNED_BYTE;
GLInternal := Iff(Format = ifA8R8G8B8, GL_RGBA8, GL_RGB8);
end;
ifR16G16B16, ifB16G16R16:
begin
GLFormat := Iff(Format = ifR16G16B16, GL_BGR_EXT, GL_RGB);
GLType := GL_UNSIGNED_SHORT;
GLInternal := GL_RGB16;
end;
ifA16R16G16B16, ifA16B16G16R16:
begin
GLFormat := Iff(Format = ifA16R16G16B16, GL_BGRA_EXT, GL_RGBA);
GLType := GL_UNSIGNED_SHORT;
GLInternal := GL_RGBA16;
end;
// Floating-Point formats
ifR32F:
begin
GLFormat := GL_RED;
GLType := GL_FLOAT;
GLInternal := GL_LUMINANCE32F_ARB;
end;
ifA32R32G32B32F, ifA32B32G32R32F:
begin
GLFormat := Iff(Format = ifA32R32G32B32F, GL_BGRA_EXT, GL_RGBA);
GLType := GL_FLOAT;
GLInternal := GL_RGBA32F_ARB;
end;
ifR16F:
begin
GLFormat := GL_RED;
GLType := GL_HALF_FLOAT_ARB;
GLInternal := GL_LUMINANCE16F_ARB;
end;
ifA16R16G16B16F, ifA16B16G16R16F:
begin
GLFormat := Iff(Format = ifA16R16G16B16F, GL_BGRA_EXT, GL_RGBA);
GLType := GL_HALF_FLOAT_ARB;
GLInternal := GL_RGBA16F_ARB;
end;
// Special formats
ifDXT1: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
ifDXT3: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
ifDXT5: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
end;
Result := GLInternal <> 0;
end;
function LoadGLTextureFromFile(const FileName: string; CreatedWidth, CreatedHeight: PLongInt): GLuint;
var
Images: TDynImageDataArray;
begin
if LoadMultiImageFromFile(FileName, Images) and (Length(Images) > 0) then
begin
Result := CreateGLTextureFromMultiImage(Images, Images[0].Width,
Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight);
end
else
Result := 0;
FreeImagesInArray(Images);
end;
function LoadGLTextureFromStream(Stream: TStream; CreatedWidth, CreatedHeight: PLongInt): GLuint;
var
Images: TDynImageDataArray;
begin
if LoadMultiImageFromStream(Stream, Images) and (Length(Images) > 0) then
begin
Result := CreateGLTextureFromMultiImage(Images, Images[0].Width,
Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight);
end
else
Result := 0;
FreeImagesInArray(Images);
end;
function LoadGLTextureFromMemory(Data: Pointer; Size: LongInt; CreatedWidth, CreatedHeight: PLongInt): GLuint;
var
Images: TDynImageDataArray;
begin
if LoadMultiImageFromMemory(Data, Size, Images) and (Length(Images) > 0) then
begin
Result := CreateGLTextureFromMultiImage(Images, Images[0].Width,
Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight);
end
else
Result := 0;
FreeImagesInArray(Images);
end;
function CreateGLTextureFromImage(const Image: TImageData;
Width, Height: LongInt; MipMaps: Boolean; OverrideFormat: TImageFormat;
CreatedWidth, CreatedHeight: PLongInt): GLuint;
var
Arr: TDynImageDataArray;
begin
// Just calls function operating on image arrays
SetLength(Arr, 1);
Arr[0] := Image;
Result := CreateGLTextureFromMultiImage(Arr, Width, Height, MipMaps, 0,
OverrideFormat, CreatedWidth, CreatedHeight);
end;
function CreateGLTextureFromMultiImage(const Images: TDynImageDataArray;
Width, Height: LongInt; MipMaps: Boolean; MainLevelIndex: LongInt; OverrideFormat: TImageFormat;
CreatedWidth, CreatedHeight: PLongInt): GLuint;
const
CompressedFormats: TImageFormats = [ifDXT1, ifDXT3, ifDXT5];
var
I, MipLevels, PossibleLevels, ExistingLevels, CurrentWidth, CurrentHeight: LongInt;
Caps: TGLTextureCaps;
GLFormat: GLenum;
GLType: GLenum;
GLInternal: GLint;
Desired, ConvTo: TImageFormat;
Info: TImageFormatInfo;
LevelsArray: TDynImageDataArray;
NeedsResize, NeedsConvert: Boolean;
UnpackAlignment, UnpackSkipRows, UnpackSkipPixels, UnpackRowLength: LongInt;
procedure PasteImage(var Image: TImageData; Width, Height: LongInt);
var
Clone: TImageData;
begin
CloneImage(Image, Clone);
NewImage(Width, Height, Clone.Format, Image);
FillRect(Image, 0, 0, Width, Height, Clone.Bits);
CopyRect(Clone, 0, 0, Clone.Width, Clone.Height, Image, 0, 0);
FreeImage(Clone);
end;
begin
Result := 0;
ExistingLevels := Length(Images);
if GetGLTextureCaps(Caps) and (ExistingLevels > 0) then
try
// Check if requested main level is at valid index
if (MainLevelIndex < 0) or (MainLevelIndex > High(Images)) then
MainLevelIndex := 0;
// First check desired size and modify it if necessary
if Width <= 0 then Width := Images[MainLevelIndex].Width;
if Height <= 0 then Height := Images[MainLevelIndex].Height;
if Caps.PowerOfTwo then
begin
// If device supports only power of 2 texture sizes
Width := NextPow2(Width);
Height := NextPow2(Height);
end;
Width := ClampInt(Width, 1, Caps.MaxTextureSize);
Height := ClampInt(Height, 1, Caps.MaxTextureSize);
// Get various mipmap level counts and modify
// desired MipLevels if its value is invalid
PossibleLevels := GetNumMipMapLevels(Width, Height);
if MipMaps then
MipLevels := PossibleLevels
else
MipLevels := 1;
// Prepare array for mipmap levels. Make it larger than necessary - that
// way we can use the same index for input images and levels in the large loop below
SetLength(LevelsArray, MipLevels + MainLevelIndex);
// Now determine which image format will be used
if OverrideFormat = ifUnknown then
Desired := Images[MainLevelIndex].Format
else
Desired := OverrideFormat;
// Check if the hardware supports floating point and compressed textures
GetImageFormatInfo(Desired, Info);
if Info.IsFloatingPoint and not Caps.FloatTextures then
Desired := ifA8R8G8B8;
if (Desired in [ifDXT1, ifDXT3, ifDXT5]) and not Caps.DXTCompression then
Desired := ifA8R8G8B8;
// Try to find GL format equivalent to image format and if it is not
// found use one of default formats
if not ImageFormatToGL(Desired, GLFormat, GLType, GLInternal) then
begin
GetImageFormatInfo(Desired, Info);
if Info.HasGrayChannel then
ConvTo := ifGray8
else
ConvTo := ifA8R8G8B8;
if not ImageFormatToGL(ConvTo, GLFormat, GLType, GLInternal) then
Exit;
end
else
ConvTo := Desired;
CurrentWidth := Width;
CurrentHeight := Height;
// If user is interested in width and height of created texture lets
// give him that
if CreatedWidth <> nil then CreatedWidth^ := CurrentWidth;
if CreatedHeight <> nil then CreatedHeight^ := CurrentHeight;
// Store old pixel unpacking settings
glGetIntegerv(GL_UNPACK_ALIGNMENT, @UnpackAlignment);
glGetIntegerv(GL_UNPACK_SKIP_ROWS, @UnpackSkipRows);
glGetIntegerv(GL_UNPACK_SKIP_PIXELS, @UnpackSkipPixels);
glGetIntegerv(GL_UNPACK_ROW_LENGTH, @UnpackRowLength);
// Set new pixel unpacking settings
glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
glPixelStorei(GL_UNPACK_SKIP_ROWS, 0);
glPixelStorei(GL_UNPACK_SKIP_PIXELS, 0);
glPixelStorei(GL_UNPACK_ROW_LENGTH, 0);
// Generate new texture, bind it and set
glGenTextures(1, @Result);
glBindTexture(GL_TEXTURE_2D, Result);
if Byte(glIsTexture(Result)) <> GL_TRUE then
Exit;
for I := MainLevelIndex to MipLevels - 1 + MainLevelIndex do
begin
// Check if we can use input image array as a source for this mipmap level
if I < ExistingLevels then
begin
// Check if input image for this mipmap level has the right
// size and format
NeedsConvert := not (Images[I].Format = ConvTo);
if ConvTo in CompressedFormats then
begin
// Input images in DXTC will have min dimensions of 4, but we need
// current Width and Height to be lesser (for glCompressedTexImage2D)
NeedsResize := not ((Images[I].Width = Max(4, CurrentWidth)) and
(Images[I].Height = Max(4, CurrentHeight)));
end
else
NeedsResize := not ((Images[I].Width = CurrentWidth) and (Images[I].Height = CurrentHeight));
if NeedsResize or NeedsConvert then
begin
// Input image must be resized or converted to different format
// to become valid mipmap level
CloneImage(Images[I], LevelsArray[I]);
if NeedsConvert then
ConvertImage(LevelsArray[I], ConvTo);
if NeedsResize then
begin
if (not PasteNonPow2ImagesIntoPow2) or (LevelsArray[I].Width > CurrentWidth) or
(LevelsArray[I].Height > CurrentHeight)then
begin
// If pasteNP2toP2 is disabled or if source is bigger than target
// we rescale image, otherwise we paste it with the same size
ResizeImage(LevelsArray[I], CurrentWidth, CurrentHeight, rfBilinear)
end
else
PasteImage(LevelsArray[I], CurrentWidth, CurrentHeight);
end;
end
else
// Input image can be used without any changes
LevelsArray[I] := Images[I];
end
else
begin
// This mipmap level is not present in the input image array
// so we create a new level
FillMipMapLevel(LevelsArray[I - 1], CurrentWidth, CurrentHeight, LevelsArray[I]);
end;
if ConvTo in CompressedFormats then
begin
// Note: GL DXTC texture snaller than 4x4 must have width and height
// as expected for non-DXTC texture (like 1x1 - we cannot
// use LevelsArray[I].Width and LevelsArray[I].Height - they are
// at least 4 for DXTC images). But Bits and Size passed to
// glCompressedTexImage2D must contain regular 4x4 DXTC block.
glCompressedTexImage2D(GL_TEXTURE_2D, I - MainLevelIndex, GLInternal, CurrentWidth,
CurrentHeight, 0, LevelsArray[I].Size, LevelsArray[I].Bits)
end
else
begin
glTexImage2D(GL_TEXTURE_2D, I - MainLevelIndex, GLInternal, CurrentWidth,
CurrentHeight, 0, GLFormat, GLType, LevelsArray[I].Bits);
end;
// Calculate width and height of the next mipmap level
CurrentWidth := ClampInt(CurrentWidth div 2, 1, CurrentWidth);
CurrentHeight := ClampInt(CurrentHeight div 2, 1, CurrentHeight);
end;
// Restore old pixel unpacking settings
glPixelStorei(GL_UNPACK_ALIGNMENT, UnpackAlignment);
glPixelStorei(GL_UNPACK_SKIP_ROWS, UnpackSkipRows);
glPixelStorei(GL_UNPACK_SKIP_PIXELS, UnpackSkipPixels);
glPixelStorei(GL_UNPACK_ROW_LENGTH, UnpackRowLength);
finally
// Free local image copies
for I := 0 to Length(LevelsArray) - 1 do
begin
if ((I < ExistingLevels) and (LevelsArray[I].Bits <> Images[I].Bits)) or
(I >= ExistingLevels) then
FreeImage(LevelsArray[I]);
end;
end;
end;
function SaveGLTextureToFile(const FileName: string; const Texture: GLuint): Boolean;
var
Arr: TDynImageDataArray;
Fmt: TImageFileFormat;
IsDDS: Boolean;
begin
Result := CreateMultiImageFromGLTexture(Texture, Arr);
if Result then
begin
Fmt := FindImageFileFormatByName(FileName);
if Fmt <> nil then
begin
IsDDS := SameText(Fmt.Extensions[0], 'dds');
if IsDDS then
begin
PushOptions;
SetOption(ImagingDDSSaveMipMapCount, Length(Arr));
end;
Result := SaveMultiImageToFile(FileName, Arr);
if IsDDS then
PopOptions;
end;
FreeImagesInArray(Arr);
end;
end;
function SaveGLTextureToStream(const Ext: string; Stream: TStream; const Texture: GLuint): Boolean;
var
Arr: TDynImageDataArray;
Fmt: TImageFileFormat;
IsDDS: Boolean;
begin
Result := CreateMultiImageFromGLTexture(Texture, Arr);
if Result then
begin
Fmt := FindImageFileFormatByExt(Ext);
if Fmt <> nil then
begin
IsDDS := SameText(Fmt.Extensions[0], 'dds');
if IsDDS then
begin
PushOptions;
SetOption(ImagingDDSSaveMipMapCount, Length(Arr));
end;
Result := SaveMultiImageToStream(Ext, Stream, Arr);
if IsDDS then
PopOptions;
end;
FreeImagesInArray(Arr);
end;
end;
function SaveGLTextureToMemory(const Ext: string; Data: Pointer; var Size: LongInt; const Texture: GLuint): Boolean;
var
Arr: TDynImageDataArray;
Fmt: TImageFileFormat;
IsDDS: Boolean;
begin
Result := CreateMultiImageFromGLTexture(Texture, Arr);
if Result then
begin
Fmt := FindImageFileFormatByExt(Ext);
if Fmt <> nil then
begin
IsDDS := SameText(Fmt.Extensions[0], 'dds');
if IsDDS then
begin
PushOptions;
SetOption(ImagingDDSSaveMipMapCount, Length(Arr));
end;
Result := SaveMultiImageToMemory(Ext, Data, Size, Arr);
if IsDDS then
PopOptions;
end;
FreeImagesInArray(Arr);
end;
end;
function CreateImageFromGLTexture(const Texture: GLuint;
var Image: TImageData; OverrideFormat: TImageFormat): Boolean;
var
Arr: TDynImageDataArray;
begin
// Just calls function operating on image arrays
FreeImage(Image);
SetLength(Arr, 1);
Result := CreateMultiImageFromGLTexture(Texture, Arr, 1, OverrideFormat);
Image := Arr[0];
end;
function CreateMultiImageFromGLTexture(const Texture: GLuint;
var Images: TDynImageDataArray; MipLevels: LongInt; OverrideFormat: TImageFormat): Boolean;
var
I, Width, Height, ExistingLevels: LongInt;
begin
FreeImagesInArray(Images);
SetLength(Images, 0);
Result := False;
if Byte(glIsTexture(Texture)) = GL_TRUE then
begin
// Check if desired mipmap level count is valid
glBindTexture(GL_TEXTURE_2D, Texture);
if MipLevels <= 0 then
MipLevels := GetNumMipMapLevels(Width, Height);
SetLength(Images, MipLevels);
ExistingLevels := 0;
for I := 0 to MipLevels - 1 do
begin
// Get the current level size
glGetTexLevelParameteriv(GL_TEXTURE_2D, I, GL_TEXTURE_WIDTH, @Width);
glGetTexLevelParameteriv(GL_TEXTURE_2D, I, GL_TEXTURE_HEIGHT, @Height);
// Break when the mipmap chain is broken
if (Width = 0) or (Height = 0) then
Break;
// Create new image and copy texture data
NewImage(Width, Height, ifA8R8G8B8, Images[I]);
glGetTexImage(GL_TEXTURE_2D, I, GL_BGRA_EXT, GL_UNSIGNED_BYTE, Images[I].Bits);
Inc(ExistingLevels);
end;
// Resize mipmap array if necessary
if MipLevels <> ExistingLevels then
SetLength(Images, ExistingLevels);
// Convert images to desired format if set
if OverrideFormat <> ifUnknown then
for I := 0 to Length(Images) - 1 do
ConvertImage(Images[I], OverrideFormat);
Result := True;
end;
end;
initialization
{
File Notes:
-- TODOS ----------------------------------------------------
- use internal format of texture in CreateMultiImageFromGLTexture
not only A8R8G8B8
- support for cube and 3D maps
-- 0.24.1 Changes/Bug Fixes ---------------------------------
- Added PasteNonPow2ImagesIntoPow2 option and related functionality.
- Better NeedsResize determination for small DXTC textures -
avoids needless resizing.
- Added MainLevelIndex to CreateMultiImageFromGLTexture.
-- 0.21 Changes/Bug Fixes -----------------------------------
- Added CreatedWidth and CreatedHeight parameters to most
LoadGLTextureFromXXX/CreateGLTextureFromXXX functions.
-- 0.19 Changes/Bug Fixes -----------------------------------
- fixed bug in CreateGLTextureFromMultiImage which caused assert failure
when creating mipmaps (using FillMipMapLevel) for DXTC formats
- changed single channel floating point texture formats from
GL_INTENSITY..._ARB to GL_LUMINANCE..._ARB
- added support for half float texture formats (GL_RGBA16F_ARB etc.)
-- 0.17 Changes/Bug Fixes -----------------------------------
- filtered mipmap creation
- more texture caps added
- fixed memory leaks in SaveGLTextureTo... functions
-- 0.15 Changes/Bug Fixes -----------------------------------
- unit created and initial stuff added
}
end.