glBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4 ------------------------------------------------------------
   5 The contents of this file are used with permission, subject to
   6 the Mozilla Public License Version 1.1 (the "License"); you may
   7 not use this file except in compliance with the License. You may
   8 obtain a copy of the License at
   9 http://www.mozilla.org/MPL/MPL-1.1.html
  10 ------------------------------------------------------------
  11 Version 2.0.3
  12 ------------------------------------------------------------
  13 History
  14 21-03-2010
  15 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  16   then it's your problem if that isn't true. This prevents the unit for incompatibility
  17   with newer versions of Delphi.
  18 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  19 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  20 10-08-2008
  21 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  22 - Additional Datapointer for functioninterface now has the name CustomData
  23 24-07-2008
  24 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  25 - If you load an texture from an file the property Filename will be set to the name of the file
  26 - Three new properties to attach custom data to the Texture objects
  27   - CustomName  (free for use string)
  28   - CustomNameW (free for use widestring)
  29   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  30 27-05-2008
  31 - RLE TGAs loaded much faster
  32 26-05-2008
  33 - fixed some problem with reading RLE TGAs.
  34 21-05-2008
  35 - function clone now only copys data if it's assigned and now it also copies the ID
  36 - it seems that lazarus dont like comments in comments.
  37 01-05-2008
  38 - It's possible to set the id of the texture
  39 - define GLB_NO_NATIVE_GL deactivated by default
  40 27-04-2008
  41 - Now supports the following libraries
  42   - SDL and SDL_image
  43   - libPNG
  44   - libJPEG
  45 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  46 - BMPs now loaded manuel
  47 - Large restructuring
  48 - Property DataPtr now has the name Data
  49 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  50 - Unused Depth removed
  51 - Function FreeData to freeing image data added
  52 24-10-2007
  53 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  54 15-11-2006
  55 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  56 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  57 - Function ReadOpenGLExtension is now only intern
  58 29-06-2006
  59 - pngimage now disabled by default like all other versions.
  60 26-06-2006
  61 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  62 22-06-2006
  63 - Fixed some Problem with Delphi 5
  64 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  65 22-03-2006
  66 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  67 09-03-2006
  68 - Internal Format ifDepth8 added
  69 - function GrabScreen now supports all uncompressed formats
  70 31-01-2006
  71 - AddAlphaFromglBitmap implemented
  72 29-12-2005
  73 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  74 28-12-2005
  75 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  76   property Width, Height, Depth are still existing and new property Dimension are avail
  77 11-12-2005
  78 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  79 19-10-2005
  80 - Added function GrabScreen to class TglBitmap2D
  81 18-10-2005
  82 - Added support to Save images
  83 - Added function Clone to Clone Instance
  84 11-10-2005
  85 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  86   Usefull for Future
  87 - Several speed optimizations
  88 09-10-2005
  89 - Internal structure change. Loading of TGA, PNG and DDS improved.
  90   Data, format and size will now set directly with SetDataPtr.
  91 - AddFunc now works with all Types of Images and Formats
  92 - Some Funtions moved to Baseclass TglBitmap
  93 06-10-2005
  94 - Added Support to decompress DXT3 and DXT5 compressed Images.
  95 - Added Mapping to convert data from one format into an other.
  96 05-10-2005
  97 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  98   supported Input format (supported by GetPixel) into any uncompresed Format
  99 - Added Support to decompress DXT1 compressed Images.
 100 - SwapColors replaced by ConvertTo
 101 04-10-2005
 102 - Added Support for compressed DDSs
 103 - Added new internal formats (DXT1, DXT3, DXT5)
 104 29-09-2005
 105 - Parameter Components renamed to InternalFormat
 106 23-09-2005
 107 - Some AllocMem replaced with GetMem (little speed change)
 108 - better exception handling. Better protection from memory leaks.
 109 22-09-2005
 110 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 111 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 112 07-09-2005
 113 - Added support for Grayscale textures
 114 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 115 10-07-2005
 116 - Added support for GL_VERSION_2_0
 117 - Added support for GL_EXT_texture_filter_anisotropic
 118 04-07-2005
 119 - Function FillWithColor fills the Image with one Color
 120 - Function LoadNormalMap added
 121 30-06-2005
 122 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 123 - ToNormalMap now supports Sobel (nmSobel) function.
 124 29-06-2005
 125 - support for RLE Compressed RGB TGAs added
 126 28-06-2005
 127 - Class TglBitmapNormalMap added to support Normalmap generation
 128 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 129   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 130 16-06-2005
 131 - Method LoadCubeMapClass removed
 132 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 133 - virtual abstract method GenTexture in class TglBitmap now is protected
 134 12-06-2005
 135 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 136 10-06-2005
 137 - little enhancement for IsPowerOfTwo
 138 - TglBitmap1D.GenTexture now tests NPOT Textures
 139 06-06-2005
 140 - some little name changes. All properties or function with Texture in name are
 141   now without texture in name. We have allways texture so we dosn't name it.
 142 03-06-2005
 143 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 144   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 145 02-06-2005
 146 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 147 25-04-2005
 148 - Function Unbind added
 149 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 150 21-04-2005
 151 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 152 29-03-2005
 153 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 154   To Enable png's use the define pngimage
 155 22-03-2005
 156 - New Functioninterface added
 157 - Function GetPixel added
 158 27-11-2004
 159 - Property BuildMipMaps renamed to MipMap
 160 21-11-2004
 161 - property Name removed.
 162 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 163 22-05-2004
 164 - property name added. Only used in glForms!
 165 26-11-2003
 166 - property FreeDataAfterGenTexture is now available as default (default = true)
 167 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 168 - function MoveMemory replaced with function Move (little speed change)
 169 - several calculations stored in variables (little speed change)
 170 29-09-2003
 171 - property BuildMipsMaps added (default = true)
 172   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 173 - property FreeDataAfterGenTexture added (default = true)
 174   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 175 - parameter DisableOtherTextureUnits of Bind removed
 176 - parameter FreeDataAfterGeneration of GenTextures removed
 177 12-09-2003
 178 - TglBitmap dosn't delete data if class was destroyed (fixed)
 179 09-09-2003
 180 - Bind now enables TextureUnits (by params)
 181 - GenTextures can leave data (by param)
 182 - LoadTextures now optimal
 183 03-09-2003
 184 - Performance optimization in AddFunc
 185 - procedure Bind moved to subclasses
 186 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 187 19-08-2003
 188 - Texturefilter and texturewrap now also as defaults
 189   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 190   Magfilter = GL_LINEAR
 191   Wrap(str) = GL_CLAMP_TO_EDGE
 192 - Added new format tfCompressed to create a compressed texture.
 193 - propertys IsCompressed, TextureSize and IsResident added
 194   IsCompressed and TextureSize only contains data from level 0
 195 18-08-2003
 196 - Added function AddFunc to add PerPixelEffects to Image
 197 - LoadFromFunc now based on AddFunc
 198 - Invert now based on AddFunc
 199 - SwapColors now based on AddFunc
 200 16-08-2003
 201 - Added function FlipHorz
 202 15-08-2003
 203 - Added function LaodFromFunc to create images with function
 204 - Added function FlipVert
 205 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 206 29-07-2003
 207 - Added Alphafunctions to calculate alpha per function
 208 - Added Alpha from ColorKey using alphafunctions
 209 28-07-2003
 210 - First full functionally Version of glBitmap
 211 - Support for 24Bit and 32Bit TGA Pictures added
 212 25-07-2003
 213 - begin of programming
 214 ***********************************************************}
 215 unit glBitmap;
 216
 217 {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 218 // Please uncomment the defines below to configure the glBitmap to your preferences.
 219 // If you have configured the unit you can uncomment the warning above.
 220
 221 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 222 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 224 // activate to enable build-in OpenGL support with statically linked methods
 225 // use dglOpenGL.pas if not enabled
 226 {$DEFINE GLB_NATIVE_OGL_STATIC}
 227
 228 // activate to enable build-in OpenGL support with dynamically linked methods
 229 // use dglOpenGL.pas if not enabled
 230 {$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 231
 232 // activate to enable the support for SDL_surfaces
 233 {.$DEFINE GLB_SDL}
 234
 235 // activate  to enable the support for TBitmap from Delphi (not lazarus)
 236 {.$DEFINE GLB_DELPHI}
 237
 238
 239 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 240 // activate to enable the support of SDL_image to load files. (READ ONLY)
 241 // If you enable SDL_image all other libraries will be ignored!
 242 {.$DEFINE GLB_SDL_IMAGE}
 243
 244 // activate to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/
 245 // if you enable pngimage the libPNG will be ignored
 246 {.$DEFINE GLB_PNGIMAGE}
 247
 248 // activate to use the libPNG http://www.libpng.org/
 249 // You will need an aditional header.
 250 // http://www.opengl24.de/index.php?cat=header&file=libpng
 251 {.$DEFINE GLB_LIB_PNG}
 252
 253 // if you enable delphi jpegs the libJPEG will be ignored
 254 {.$DEFINE GLB_DELPHI_JPEG}
 255
 256 // activateto use the libJPEG http://www.ijg.org/
 257 // You will need an aditional header.
 258 // http://www.opengl24.de/index.php?cat=header&file=libjpeg
 259 {.$DEFINE GLB_LIB_JPEG}
 260
 261
 262 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 263 // PRIVATE: DO not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 265 // Delphi Versions
 266 {$IFDEF fpc}
 267   {$MODE Delphi}
 268
 269   {$IFDEF CPUI386}
 270     {$DEFINE CPU386}
 271     {$ASMMODE INTEL}
 272   {$ENDIF}
 273
 274   {$IFNDEF WINDOWS}
 275     {$linklib c}
 276   {$ENDIF}
 277 {$ENDIF}
 278
 279 // Operation System
 280 {$IF DEFINED(WIN32) or DEFINED(WIN64)}
 281   {$DEFINE GLB_WIN}
 282 {$ELSEIF DEFINED(LINUX)}
 283   {$DEFINE GLB_LINUX}
 284 {$IFEND}
 285
 286 // native OpenGL Support
 287 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 288   {$DEFINE GLB_NATIVE_OGL}
 289 {$IFEND}
 290
 291 // checking define combinations
 292 //SDL Image
 293 {$IFDEF GLB_SDL_IMAGE}
 294   {$IFNDEF GLB_SDL}
 295     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 296     {$DEFINE GLB_SDL}
 297   {$ENDIF}
 298   {$IFDEF GLB_PNGIMAGE}
 299     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 300     {$undef GLB_PNGIMAGE}
 301   {$ENDIF}
 302   {$IFDEF GLB_DELPHI_JPEG}
 303     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 304     {$undef GLB_DELPHI_JPEG}
 305   {$ENDIF}
 306   {$IFDEF GLB_LIB_PNG}
 307     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 308     {$undef GLB_LIB_PNG}
 309   {$ENDIF}
 310   {$IFDEF GLB_LIB_JPEG}
 311     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 312     {$undef GLB_LIB_JPEG}
 313   {$ENDIF}
 314
 315   {$DEFINE GLB_SUPPORT_PNG_READ}
 316   {$DEFINE GLB_SUPPORT_JPEG_READ}
 317 {$ENDIF}
 318
 319 // PNG Image
 320 {$IFDEF GLB_PNGIMAGE}
 321   {$IFDEF GLB_LIB_PNG}
 322     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 323     {$undef GLB_LIB_PNG}
 324   {$ENDIF}
 325
 326   {$DEFINE GLB_SUPPORT_PNG_READ}
 327   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 328 {$ENDIF}
 329
 330 // libPNG
 331 {$IFDEF GLB_LIB_PNG}
 332   {$DEFINE GLB_SUPPORT_PNG_READ}
 333   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 334 {$ENDIF}
 335
 336 // JPEG Image
 337 {$IFDEF GLB_DELPHI_JPEG}
 338   {$IFDEF GLB_LIB_JPEG}
 339     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 340     {$undef GLB_LIB_JPEG}
 341   {$ENDIF}
 342
 343   {$DEFINE GLB_SUPPORT_JPEG_READ}
 344   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 345 {$ENDIF}
 346
 347 // libJPEG
 348 {$IFDEF GLB_LIB_JPEG}
 349   {$DEFINE GLB_SUPPORT_JPEG_READ}
 350   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 351 {$ENDIF}
 352
 353 // native OpenGL
 354 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 355   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 356 {$ENDIF}
 357
 358 // general options
 359 {$EXTENDEDSYNTAX ON}
 360 {$LONGSTRINGS ON}
 361 {$ALIGN ON}
 362 {$IFNDEF FPC}
 363   {$OPTIMIZATION ON}
 364 {$ENDIF}
 365
 366 interface
 367
 368 uses
 369   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                   {$ENDIF}
 370   {$IF DEFINED(GLB_WIN) AND
 371        DEFINED(GLB_NATIVE_OGL)} windows,                 {$IFEND}
 372
 373   {$IFDEF GLB_SDL}              SDL,                         {$ENDIF}
 374   {$IFDEF GLB_DELPHI}           Dialogs, Graphics,           {$ENDIF}
 375
 376   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                   {$ENDIF}
 377
 378   {$IFDEF GLB_PNGIMAGE}         pngimage,                    {$ENDIF}
 379   {$IFDEF GLB_LIB_PNG}          libPNG,                      {$ENDIF}
 380
 381   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                        {$ENDIF}
 382   {$IFDEF GLB_LIB_JPEG}         libJPEG,                     {$ENDIF}
 383
 384   Classes, SysUtils;
 385
 386 {$IFNDEF GLB_DELPHI}
 387 type
 388   HGLRC = Cardinal;
 389   DWORD = Cardinal;
 390   PDWORD = ^DWORD;
 391
 392   TRGBQuad = packed record
 393     rgbBlue: Byte;
 394     rgbGreen: Byte;
 395     rgbRed: Byte;
 396     rgbReserved: Byte;
 397   end;
 398 {$ENDIF}
 399
 400 {$IFDEF GLB_NATIVE_OGL}
 401 const
 402   GL_TRUE   = 1;
 403   GL_FALSE  = 0;
 404
 405   GL_VERSION    = $1F02;
 406   GL_EXTENSIONS = $1F03;
 407
 408   GL_TEXTURE_1D         = $0DE0;
 409   GL_TEXTURE_2D         = $0DE1;
 410   GL_TEXTURE_RECTANGLE  = $84F5;
 411
 412   GL_TEXTURE_WIDTH            = $1000;
 413   GL_TEXTURE_HEIGHT           = $1001;
 414   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 415
 416   GL_ALPHA    = $1906;
 417   GL_ALPHA4   = $803B;
 418   GL_ALPHA8   = $803C;
 419   GL_ALPHA12  = $803D;
 420   GL_ALPHA16  = $803E;
 421
 422   GL_LUMINANCE    = $1909;
 423   GL_LUMINANCE4   = $803F;
 424   GL_LUMINANCE8   = $8040;
 425   GL_LUMINANCE12  = $8041;
 426   GL_LUMINANCE16  = $8042;
 427
 428   GL_LUMINANCE_ALPHA      = $190A;
 429   GL_LUMINANCE4_ALPHA4    = $8043;
 430   GL_LUMINANCE6_ALPHA2    = $8044;
 431   GL_LUMINANCE8_ALPHA8    = $8045;
 432   GL_LUMINANCE12_ALPHA4   = $8046;
 433   GL_LUMINANCE12_ALPHA12  = $8047;
 434   GL_LUMINANCE16_ALPHA16  = $8048;
 435
 436   GL_RGB      = $1907;
 437   GL_BGR      = $80E0;
 438   GL_R3_G3_B2 = $2A10;
 439   GL_RGB4     = $804F;
 440   GL_RGB5     = $8050;
 441   GL_RGB565   = $8D62;
 442   GL_RGB8     = $8051;
 443   GL_RGB10    = $8052;
 444   GL_RGB12    = $8053;
 445   GL_RGB16    = $8054;
 446
 447   GL_RGBA     = $1908;
 448   GL_BGRA     = $80E1;
 449   GL_RGBA2    = $8055;
 450   GL_RGBA4    = $8056;
 451   GL_RGB5_A1  = $8057;
 452   GL_RGBA8    = $8058;
 453   GL_RGB10_A2 = $8059;
 454   GL_RGBA12   = $805A;
 455   GL_RGBA16   = $805B;
 456
 457   GL_DEPTH_COMPONENT    = $1902;
 458   GL_DEPTH_COMPONENT16  = $81A5;
 459   GL_DEPTH_COMPONENT24  = $81A6;
 460   GL_DEPTH_COMPONENT32  = $81A7;
 461
 462   GL_COMPRESSED_RGB                 = $84ED;
 463   GL_COMPRESSED_RGBA                = $84EE;
 464   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 465   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 466   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 467   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 468
 469   GL_UNSIGNED_BYTE            = $1401;
 470   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 471   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 472
 473   GL_UNSIGNED_SHORT             = $1403;
 474   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 475   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 476   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 477   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 478   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 479   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 480
 481   GL_UNSIGNED_INT                 = $1405;
 482   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 483   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 484   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 485   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 486
 487   { Texture Filter }
 488   GL_TEXTURE_MAG_FILTER     = $2800;
 489   GL_TEXTURE_MIN_FILTER     = $2801;
 490   GL_NEAREST                = $2600;
 491   GL_NEAREST_MIPMAP_NEAREST = $2700;
 492   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 493   GL_LINEAR                 = $2601;
 494   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 495   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 496
 497   { Texture Wrap }
 498   GL_TEXTURE_WRAP_S   = $2802;
 499   GL_TEXTURE_WRAP_T   = $2803;
 500   GL_TEXTURE_WRAP_R   = $8072;
 501   GL_CLAMP            = $2900;
 502   GL_REPEAT           = $2901;
 503   GL_CLAMP_TO_EDGE    = $812F;
 504   GL_CLAMP_TO_BORDER  = $812D;
 505   GL_MIRRORED_REPEAT  = $8370;
 506
 507   { Other }
 508   GL_GENERATE_MIPMAP      = $8191;
 509   GL_TEXTURE_BORDER_COLOR = $1004;
 510   GL_MAX_TEXTURE_SIZE     = $0D33;
 511   GL_PACK_ALIGNMENT       = $0D05;
 512   GL_UNPACK_ALIGNMENT     = $0CF5;
 513
 514   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 515   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 516
 517 {$ifdef LINUX}
 518   libglu    = 'libGLU.so.1';
 519   libopengl = 'libGL.so.1';
 520 {$else}
 521   libglu    = 'glu32.dll';
 522   libopengl = 'opengl32.dll';
 523 {$endif}
 524
 525 type
 526   GLboolean = BYTEBOOL;
 527   GLint     = Integer;
 528   GLsizei   = Integer;
 529   GLuint    = Cardinal;
 530   GLfloat   = Single;
 531   GLenum    = Cardinal;
 532
 533   PGLvoid    = Pointer;
 534   PGLboolean = ^GLboolean;
 535   PGLint     = ^GLint;
 536   PGLuint    = ^GLuint;
 537   PGLfloat   = ^GLfloat;
 538
 539   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 540   TglCompressedTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 541   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 542
 543 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 544   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 545   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 546
 547   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 548   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 549
 550   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 551   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 552   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 553   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 554   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 555   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 556
 557   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 558   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 559   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 560
 561   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 562   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 563   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 564
 565   TglTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 566   TglTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 567   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 568
 569   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 570   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 571
 572   {$IFDEF GLB_LINUX}
 573   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 574   {$ELSE}
 575   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 576   {$ENDIF}
 577
 578 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 579   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 580   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 581
 582   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 583   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 584
 585   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 586   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 587   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 588   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 589   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 590   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 591
 592   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 593   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 594   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 595
 596   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 597   procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 598   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 599
 600   procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 601   procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 602   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 603
 604   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 605   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 606 {$ENDIF}
 607
 608 var
 609   GL_VERSION_1_2,
 610   GL_VERSION_1_3,
 611   GL_VERSION_1_4,
 612   GL_VERSION_2_0,
 613
 614   GL_SGIS_generate_mipmap,
 615
 616   GL_ARB_texture_border_clamp,
 617   GL_ARB_texture_mirrored_repeat,
 618   GL_ARB_texture_rectangle,
 619   GL_ARB_texture_non_power_of_two,
 620
 621   GL_IBM_texture_mirrored_repeat,
 622
 623   GL_NV_texture_rectangle,
 624
 625   GL_EXT_texture_edge_clamp,
 626   GL_EXT_texture_rectangle,
 627   GL_EXT_texture_filter_anisotropic: Boolean;
 628
 629   glCompressedTexImage1D: TglCompressedTexImage1D;
 630   glCompressedTexImage2D: TglCompressedTexImage2D;
 631   glGetCompressedTexImage: TglGetCompressedTexImage;
 632
 633 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 634   glEnable: TglEnable;
 635   glDisable: TglDisable;
 636
 637   glGetString: TglGetString;
 638   glGetIntegerv: TglGetIntegerv;
 639
 640   glTexParameteri: TglTexParameteri;
 641   glTexParameterfv: TglTexParameterfv;
 642   glGetTexParameteriv: TglGetTexParameteriv;
 643   glGetTexParameterfv: TglGetTexParameterfv;
 644   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 645   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 646
 647   glGenTextures: TglGenTextures;
 648   glBindTexture: TglBindTexture;
 649   glDeleteTextures: TglDeleteTextures;
 650
 651   glAreTexturesResident: TglAreTexturesResident;
 652   glReadPixels: TglReadPixels;
 653   glPixelStorei: TglPixelStorei;
 654
 655   glTexImage1D: TglTexImage1D;
 656   glTexImage2D: TglTexImage2D;
 657   glGetTexImage: TglGetTexImage;
 658
 659   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 660   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 661
 662   {$IF DEFINED(GLB_WIN)}
 663   wglGetProcAddress: TwglGetProcAddress;
 664   {$ELSEIF DEFINED(GLB_LINUX)}
 665   glXGetProcAddress: TglXGetProcAddress;
 666   glXGetProcAddressARB: TglXGetProcAddressARB;
 667   {$ENDIF}
 668 {$ENDIF}
 669
 670 (*
 671 {$IFDEF GLB_DELPHI}
 672 var
 673   gLastContext: HGLRC;
 674 {$ENDIF}
 675 *)
 676
 677 {$ENDIF}
 678
 679 type
 680 ////////////////////////////////////////////////////////////////////////////////////////////////////
 681   EglBitmapException               = class(Exception);
 682   EglBitmapSizeToLargeException    = class(EglBitmapException);
 683   EglBitmapNonPowerOfTwoException  = class(EglBitmapException);
 684   EglBitmapUnsupportedFormatFormat = class(EglBitmapException);
 685
 686 ////////////////////////////////////////////////////////////////////////////////////////////////////
 687   TglBitmapFormat = (
 688     tfEmpty = 0, //must be smallest value!
 689
 690     tfAlpha4,
 691     tfAlpha8,
 692     tfAlpha12,
 693     tfAlpha16,
 694
 695     tfLuminance4,
 696     tfLuminance8,
 697     tfLuminance12,
 698     tfLuminance16,
 699
 700     tfLuminance4Alpha4,
 701     tfLuminance6Alpha2,
 702     tfLuminance8Alpha8,
 703     tfLuminance12Alpha4,
 704     tfLuminance12Alpha12,
 705     tfLuminance16Alpha16,
 706
 707     tfR3G3B2,
 708     tfRGB4,
 709     tfR5G6B5,
 710     tfRGB5,
 711     tfRGB8,
 712     tfRGB10,
 713     tfRGB12,
 714     tfRGB16,
 715
 716     tfRGBA2,
 717     tfRGBA4,
 718     tfRGB5A1,
 719     tfRGBA8,
 720     tfRGB10A2,
 721     tfRGBA12,
 722     tfRGBA16,
 723
 724     tfBGR4,
 725     tfB5G6R5,
 726     tfBGR5,
 727     tfBGR8,
 728     tfBGR10,
 729     tfBGR12,
 730     tfBGR16,
 731
 732     tfBGRA2,
 733     tfBGRA4,
 734     tfBGR5A1,
 735     tfBGRA8,
 736     tfBGR10A2,
 737     tfBGRA12,
 738     tfBGRA16,
 739
 740     tfDepth16,
 741     tfDepth24,
 742     tfDepth32,
 743
 744     tfS3tcDtx1RGBA,
 745     tfS3tcDtx3RGBA,
 746     tfS3tcDtx5RGBA
 747   );
 748
 749   TglBitmapFileType = (
 750      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 751      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 752      ftDDS,
 753      ftTGA,
 754      ftBMP);
 755    TglBitmapFileTypes = set of TglBitmapFileType;
 756
 757    TglBitmapMipMap = (
 758      mmNone,
 759      mmMipmap,
 760      mmMipmapGlu);
 761
 762    TglBitmapNormalMapFunc = (
 763      nm4Samples,
 764      nmSobel,
 765      nm3x3,
 766      nm5x5);
 767
 768 ////////////////////////////////////////////////////////////////////////////////////////////////////
 769   TglBitmapColorRec = packed record
 770   case Integer of
 771     0: (r, g, b, a: Cardinal);
 772     1: (arr: array[0..3] of Cardinal);
 773   end;
 774
 775   TglBitmapPixelData = packed record
 776     Data, Range: TglBitmapColorRec;
 777     Format: TglBitmapFormat;
 778   end;
 779   PglBitmapPixelData = ^TglBitmapPixelData;
 780
 781 ////////////////////////////////////////////////////////////////////////////////////////////////////
 782   TglBitmapPixelPositionFields = set of (ffX, ffY);
 783   TglBitmapPixelPosition = record
 784     Fields : TglBitmapPixelPositionFields;
 785     X : Word;
 786     Y : Word;
 787   end;
 788
 789 ////////////////////////////////////////////////////////////////////////////////////////////////////
 790   TglBitmap = class;
 791   TglBitmapFunctionRec = record
 792     Sender:   TglBitmap;
 793     Size:     TglBitmapPixelPosition;
 794     Position: TglBitmapPixelPosition;
 795     Source:   TglBitmapPixelData;
 796     Dest:     TglBitmapPixelData;
 797     Args:     PtrInt;
 798   end;
 799   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 800
 801 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 802   TglBitmap = class
 803   protected
 804     fID: GLuint;
 805     fTarget: GLuint;
 806     fAnisotropic: Integer;
 807     fDeleteTextureOnFree: Boolean;
 808     fFreeDataAfterGenTexture: Boolean;
 809     fData: PByte;
 810     fIsResident: Boolean;
 811     fBorderColor: array[0..3] of Single;
 812
 813     fDimension: TglBitmapPixelPosition;
 814     fMipMap: TglBitmapMipMap;
 815     fFormat: TglBitmapFormat;
 816
 817     // Mapping
 818     fPixelSize: Integer;
 819     fRowSize: Integer;
 820
 821     // Filtering
 822     fFilterMin: Cardinal;
 823     fFilterMag: Cardinal;
 824
 825     // TexturWarp
 826     fWrapS: Cardinal;
 827     fWrapT: Cardinal;
 828     fWrapR: Cardinal;
 829
 830     // CustomData
 831     fFilename: String;
 832     fCustomName: String;
 833     fCustomNameW: WideString;
 834     fCustomData: Pointer;
 835
 836     //Getter
 837     function GetWidth:  Integer; virtual;
 838     function GetHeight: Integer; virtual;
 839
 840     function GetFileWidth:  Integer; virtual;
 841     function GetFileHeight: Integer; virtual;
 842
 843     //Setter
 844     procedure SetCustomData(const aValue: Pointer);
 845     procedure SetCustomName(const aValue: String);
 846     procedure SetCustomNameW(const aValue: WideString);
 847     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 848     procedure SetFormat(const aValue: TglBitmapFormat);
 849     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 850     procedure SetID(const aValue: Cardinal);
 851     procedure SetMipMap(const aValue: TglBitmapMipMap);
 852     procedure SetTarget(const aValue: Cardinal);
 853     procedure SetAnisotropic(const aValue: Integer);
 854
 855     procedure CreateID;
 856     procedure SetupParameters(var aBuildWithGlu: Boolean);
 857     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
 858       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 859     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 860
 861     function FlipHorz: Boolean; virtual;
 862     function FlipVert: Boolean; virtual;
 863
 864     property Width:  Integer read GetWidth;
 865     property Height: Integer read GetHeight;
 866
 867     property FileWidth:  Integer read GetFileWidth;
 868     property FileHeight: Integer read GetFileHeight;
 869   public
 870     //Properties
 871     property ID:           Cardinal        read fID          write SetID;
 872     property Target:       Cardinal        read fTarget      write SetTarget;
 873     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 874     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 875     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 876
 877     property Filename:    String     read fFilename;
 878     property CustomName:  String     read fCustomName  write SetCustomName;
 879     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
 880     property CustomData:  Pointer    read fCustomData  write SetCustomData;
 881
 882     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
 883     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
 884
 885     property Dimension:  TglBitmapPixelPosition  read fDimension;
 886     property Data:       PByte                   read fData;
 887     property IsResident: Boolean                 read fIsResident;
 888
 889     procedure AfterConstruction; override;
 890     procedure BeforeDestruction; override;
 891
 892     //Load
 893     procedure LoadFromFile(const aFilename: String);
 894     procedure LoadFromStream(const aStream: TStream); virtual;
 895     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
 896       const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0);
 897     {$IFDEF GLB_DELPHI}
 898     procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
 899     procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 900     {$ENDIF}
 901
 902     //Save
 903     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
 904     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 905
 906     //Convert
 907     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt = 0): Boolean; overload;
 908     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 909       const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0): Boolean; overload;
 910   public
 911     //Alpha & Co
 912     {$IFDEF GLB_SDL}
 913     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 914     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 915     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 916     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
 917       const aArgs: PtrInt = 0): Boolean;
 918     {$ENDIF}
 919
 920     {$IFDEF GLB_DELPHI}
 921     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 922     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 923     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 924     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
 925       const aArgs: PtrInt = 0): Boolean;
 926     function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
 927       const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 928     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
 929       const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 930     {$ENDIF}
 931
 932     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0): Boolean; virtual;
 933     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 934     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 935     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 936
 937     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 938     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 939     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 940
 941     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 942     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 943     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 944
 945     function RemoveAlpha: Boolean; virtual;
 946   public
 947     //Common
 948     function Clone: TglBitmap;
 949     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 950     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
 951     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
 952     procedure FreeData;
 953
 954     //ColorFill
 955     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 956     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 957     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
 958
 959     //TexParameters
 960     procedure SetFilter(const aMin, aMag: Cardinal);
 961     procedure SetWrap(
 962       const S: Cardinal = GL_CLAMP_TO_EDGE;
 963       const T: Cardinal = GL_CLAMP_TO_EDGE;
 964       const R: Cardinal = GL_CLAMP_TO_EDGE);
 965
 966     procedure GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);   virtual;
 967     procedure SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData); virtual;
 968
 969     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
 970     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
 971
 972     //Constructors
 973     constructor Create; overload;
 974     constructor Create(const aFileName: String); overload;
 975     constructor Create(const aStream: TStream); overload;
 976     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
 977     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0); overload;
 978     {$IFDEF GLB_DELPHI}
 979     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 980     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 981     {$ENDIF}
 982   private
 983     {$IFDEF GLB_SUPPORT_PNG_READ}
 984     function LoadPNG(const aStream: TStream): Boolean; virtual;
 985     procedure SavePNG(const aStream: TStream); virtual;
 986     {$ENDIF}
 987     {$IFDEF GLB_SUPPORT_JPEG_READ}
 988     function LoadJPEG(const aStream: TStream): Boolean; virtual;
 989     procedure SaveJPEG(const aStream: TStream); virtual;
 990     {$ENDIF}
 991     function LoadBMP(const aStream: TStream): Boolean; virtual;
 992     procedure SaveBMP(const aStream: TStream); virtual;
 993
 994     function LoadTGA(const aStream: TStream): Boolean; virtual;
 995     procedure SaveTGA(const aStream: TStream); virtual;
 996
 997     function LoadDDS(const aStream: TStream): Boolean; virtual;
 998     procedure SaveDDS(const aStream: TStream); virtual;
 999   end;
1000
1001 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1002   TglBitmap2D = class(TglBitmap)
1003   protected
1004     // Bildeinstellungen
1005     fLines: array of PByte;
1006
1007     (* TODO
1008     procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
1009     procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1010     procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1011     procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1012     procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1013     procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
1014     *)
1015
1016     function GetScanline(const aIndex: Integer): Pointer;
1017     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
1018       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1019     procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
1020   public
1021     property Width;
1022     property Height;
1023     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1024
1025     procedure AfterConstruction; override;
1026
1027     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1028     procedure GetDataFromTexture;
1029     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1030
1031     function FlipHorz: Boolean; override;
1032     function FlipVert: Boolean; override;
1033
1034     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1035       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1036   end;
1037
1038 (* TODO
1039   TglBitmapCubeMap = class(TglBitmap2D)
1040   protected
1041     fGenMode: Integer;
1042
1043     // Hide GenTexture
1044     procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
1045   public
1046     procedure AfterConstruction; override;
1047
1048     procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
1049
1050     procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
1051     procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
1052   end;
1053
1054
1055   TglBitmapNormalMap = class(TglBitmapCubeMap)
1056   public
1057     procedure AfterConstruction; override;
1058
1059     procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
1060   end;
1061
1062
1063   TglBitmap1D = class(TglBitmap)
1064   protected
1065     procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1066
1067     procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
1068     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
1069   public
1070     // propertys
1071     property Width;
1072
1073     procedure AfterConstruction; override;
1074
1075     // Other
1076     function FlipHorz: Boolean; override;
1077
1078     // Generation
1079     procedure GenTexture(TestTextureSize: Boolean = true); override;
1080   end;
1081 *)
1082
1083 const
1084   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1085
1086 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1087 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1088 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1089 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1090 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1091 procedure glBitmapSetDefaultWrap(
1092   const S: Cardinal = GL_CLAMP_TO_EDGE;
1093   const T: Cardinal = GL_CLAMP_TO_EDGE;
1094   const R: Cardinal = GL_CLAMP_TO_EDGE);
1095
1096 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1097 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1098 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1099 function glBitmapGetDefaultFormat: TglBitmapFormat;
1100 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1101 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1102
1103 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1104 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1105 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1106
1107 var
1108   glBitmapDefaultDeleteTextureOnFree: Boolean;
1109   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1110   glBitmapDefaultFormat: TglBitmapFormat;
1111   glBitmapDefaultMipmap: TglBitmapMipMap;
1112   glBitmapDefaultFilterMin: Cardinal;
1113   glBitmapDefaultFilterMag: Cardinal;
1114   glBitmapDefaultWrapS: Cardinal;
1115   glBitmapDefaultWrapT: Cardinal;
1116   glBitmapDefaultWrapR: Cardinal;
1117
1118 {$IFDEF GLB_DELPHI}
1119 function CreateGrayPalette: HPALETTE;
1120 {$ENDIF}
1121
1122 implementation
1123
1124
1125     (* TODO
1126     function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
1127     function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
1128     function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1129     function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1130     function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
1131     *)
1132
1133 uses
1134   Math, syncobjs;
1135
1136 type
1137 ////////////////////////////////////////////////////////////////////////////////////////////////////
1138   TShiftRec = packed record
1139   case Integer of
1140     0: (r, g, b, a: Byte);
1141     1: (arr: array[0..3] of Byte);
1142   end;
1143
1144   TFormatDescriptor = class(TObject)
1145   private
1146     function GetRedMask: UInt64;
1147     function GetGreenMask: UInt64;
1148     function GetBlueMask: UInt64;
1149     function GetAlphaMask: UInt64;
1150   protected
1151     fFormat: TglBitmapFormat;
1152     fWithAlpha: TglBitmapFormat;
1153     fWithoutAlpha: TglBitmapFormat;
1154     fRGBInverted: TglBitmapFormat;
1155     fUncompressed: TglBitmapFormat;
1156     fPixelSize: Single;
1157     fIsCompressed: Boolean;
1158
1159     fRange: TglBitmapColorRec;
1160     fShift: TShiftRec;
1161
1162     fglFormat:         Cardinal;
1163     fglInternalFormat: Cardinal;
1164     fglDataFormat:     Cardinal;
1165
1166     function GetComponents: Integer; virtual;
1167   public
1168     property Format:       TglBitmapFormat read fFormat;
1169     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1170     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1171     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1172     property Components:   Integer         read GetComponents;
1173     property PixelSize:    Single          read fPixelSize;
1174     property IsCompressed: Boolean         read fIsCompressed;
1175
1176     property glFormat:         Cardinal read fglFormat;
1177     property glInternalFormat: Cardinal read fglInternalFormat;
1178     property glDataFormat:     Cardinal read fglDataFormat;
1179
1180     property Range: TglBitmapColorRec read fRange;
1181     property Shift: TShiftRec         read fShift;
1182
1183     property RedMask:   UInt64 read GetRedMask;
1184     property GreenMask: UInt64 read GetGreenMask;
1185     property BlueMask:  UInt64 read GetBlueMask;
1186     property AlphaMask: UInt64 read GetAlphaMask;
1187
1188     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1189     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1190
1191     function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
1192     function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
1193
1194     function CreateMappingData: Pointer; virtual;
1195     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1196
1197     function IsEmpty:  Boolean; virtual;
1198     function HasAlpha: Boolean; virtual;
1199     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean; virtual;
1200
1201     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1202
1203     constructor Create; virtual;
1204   public
1205     class procedure Init;
1206     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1207     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1208     class procedure Clear;
1209     class procedure Finalize;
1210   end;
1211   TFormatDescriptorClass = class of TFormatDescriptor;
1212
1213   TfdEmpty = class(TFormatDescriptor);
1214
1215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1216   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1217     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1218     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1219     constructor Create; override;
1220   end;
1221
1222   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1223     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1224     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1225     constructor Create; override;
1226   end;
1227
1228   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1229     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1230     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1231     constructor Create; override;
1232   end;
1233
1234   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1235     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1236     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1237     constructor Create; override;
1238   end;
1239
1240   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1241     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1242     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1243     constructor Create; override;
1244   end;
1245
1246   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1247     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1248     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1249     constructor Create; override;
1250   end;
1251
1252   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1253     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1254     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1255     constructor Create; override;
1256   end;
1257
1258   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1259     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1260     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1261     constructor Create; override;
1262   end;
1263
1264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1265   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1266     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1267     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1268     constructor Create; override;
1269   end;
1270
1271   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1272     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1273     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1274     constructor Create; override;
1275   end;
1276
1277   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1278     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1279     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1280     constructor Create; override;
1281   end;
1282
1283   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1284     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1285     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1286     constructor Create; override;
1287   end;
1288
1289   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1290     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1291     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1292     constructor Create; override;
1293   end;
1294
1295   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1296     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1297     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1298     constructor Create; override;
1299   end;
1300
1301   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1302     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1303     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1304     constructor Create; override;
1305   end;
1306
1307   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1308     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1309     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1310     constructor Create; override;
1311   end;
1312
1313   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1314     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1315     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1316     constructor Create; override;
1317   end;
1318
1319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1320   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1321     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1322     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1323     constructor Create; override;
1324   end;
1325
1326   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1327     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1328     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1329     constructor Create; override;
1330   end;
1331
1332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1333   TfdAlpha4 = class(TfdAlpha_UB1)
1334     constructor Create; override;
1335   end;
1336
1337   TfdAlpha8 = class(TfdAlpha_UB1)
1338     constructor Create; override;
1339   end;
1340
1341   TfdAlpha12 = class(TfdAlpha_US1)
1342     constructor Create; override;
1343   end;
1344
1345   TfdAlpha16 = class(TfdAlpha_US1)
1346     constructor Create; override;
1347   end;
1348
1349   TfdLuminance4 = class(TfdLuminance_UB1)
1350     constructor Create; override;
1351   end;
1352
1353   TfdLuminance8 = class(TfdLuminance_UB1)
1354     constructor Create; override;
1355   end;
1356
1357   TfdLuminance12 = class(TfdLuminance_US1)
1358     constructor Create; override;
1359   end;
1360
1361   TfdLuminance16 = class(TfdLuminance_US1)
1362     constructor Create; override;
1363   end;
1364
1365   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1366     constructor Create; override;
1367   end;
1368
1369   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1370     constructor Create; override;
1371   end;
1372
1373   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1374     constructor Create; override;
1375   end;
1376
1377   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1378     constructor Create; override;
1379   end;
1380
1381   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1382     constructor Create; override;
1383   end;
1384
1385   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1386     constructor Create; override;
1387   end;
1388
1389   TfdR3G3B2 = class(TfdUniversal_UB1)
1390     constructor Create; override;
1391   end;
1392
1393   TfdRGB4 = class(TfdUniversal_US1)
1394     constructor Create; override;
1395   end;
1396
1397   TfdR5G6B5 = class(TfdUniversal_US1)
1398     constructor Create; override;
1399   end;
1400
1401   TfdRGB5 = class(TfdUniversal_US1)
1402     constructor Create; override;
1403   end;
1404
1405   TfdRGB8 = class(TfdRGB_UB3)
1406     constructor Create; override;
1407   end;
1408
1409   TfdRGB10 = class(TfdUniversal_UI1)
1410     constructor Create; override;
1411   end;
1412
1413   TfdRGB12 = class(TfdRGB_US3)
1414     constructor Create; override;
1415   end;
1416
1417   TfdRGB16 = class(TfdRGB_US3)
1418     constructor Create; override;
1419   end;
1420
1421   TfdRGBA2 = class(TfdRGBA_UB4)
1422     constructor Create; override;
1423   end;
1424
1425   TfdRGBA4 = class(TfdUniversal_US1)
1426     constructor Create; override;
1427   end;
1428
1429   TfdRGB5A1 = class(TfdUniversal_US1)
1430     constructor Create; override;
1431   end;
1432
1433   TfdRGBA8 = class(TfdRGBA_UB4)
1434     constructor Create; override;
1435   end;
1436
1437   TfdRGB10A2 = class(TfdUniversal_UI1)
1438     constructor Create; override;
1439   end;
1440
1441   TfdRGBA12 = class(TfdRGBA_US4)
1442     constructor Create; override;
1443   end;
1444
1445   TfdRGBA16 = class(TfdRGBA_US4)
1446     constructor Create; override;
1447   end;
1448
1449   TfdBGR4 = class(TfdUniversal_US1)
1450     constructor Create; override;
1451   end;
1452
1453   TfdB5G6R5 = class(TfdUniversal_US1)
1454     constructor Create; override;
1455   end;
1456
1457   TfdBGR5 = class(TfdUniversal_US1)
1458     constructor Create; override;
1459   end;
1460
1461   TfdBGR8 = class(TfdBGR_UB3)
1462     constructor Create; override;
1463   end;
1464
1465   TfdBGR10 = class(TfdUniversal_UI1)
1466     constructor Create; override;
1467   end;
1468
1469   TfdBGR12 = class(TfdBGR_US3)
1470     constructor Create; override;
1471   end;
1472
1473   TfdBGR16 = class(TfdBGR_US3)
1474     constructor Create; override;
1475   end;
1476
1477   TfdBGRA2 = class(TfdBGRA_UB4)
1478     constructor Create; override;
1479   end;
1480
1481   TfdBGRA4 = class(TfdUniversal_US1)
1482     constructor Create; override;
1483   end;
1484
1485   TfdBGR5A1 = class(TfdUniversal_US1)
1486     constructor Create; override;
1487   end;
1488
1489   TfdBGRA8 = class(TfdBGRA_UB4)
1490     constructor Create; override;
1491   end;
1492
1493   TfdBGR10A2 = class(TfdUniversal_UI1)
1494     constructor Create; override;
1495   end;
1496
1497   TfdBGRA12 = class(TfdBGRA_US4)
1498     constructor Create; override;
1499   end;
1500
1501   TfdBGRA16 = class(TfdBGRA_US4)
1502     constructor Create; override;
1503   end;
1504
1505   TfdDepth16 = class(TfdDepth_US1)
1506     constructor Create; override;
1507   end;
1508
1509   TfdDepth24 = class(TfdDepth_UI1)
1510     constructor Create; override;
1511   end;
1512
1513   TfdDepth32 = class(TfdDepth_UI1)
1514     constructor Create; override;
1515   end;
1516
1517   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1518     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1519     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1520     constructor Create; override;
1521   end;
1522
1523   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1524     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1525     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1526     constructor Create; override;
1527   end;
1528
1529   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1530     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1531     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1532     constructor Create; override;
1533   end;
1534
1535 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1536   TbmpBitfieldFormat = class(TFormatDescriptor)
1537   private
1538     procedure SetRedMask  (const aValue: UInt64);
1539     procedure SetGreenMask(const aValue: UInt64);
1540     procedure SetBlueMask (const aValue: UInt64);
1541     procedure SetAlphaMask(const aValue: UInt64);
1542
1543     procedure Update(aMask: UInt64; out aRange: Cardinal; out aShift: Byte);
1544   public
1545     property RedMask:   UInt64 read GetRedMask   write SetRedMask;
1546     property GreenMask: UInt64 read GetGreenMask write SetGreenMask;
1547     property BlueMask:  UInt64 read GetBlueMask  write SetBlueMask;
1548     property AlphaMask: UInt64 read GetAlphaMask write SetAlphaMask;
1549
1550     property PixelSize: Single read fPixelSize write fPixelSize;
1551
1552     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1553     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1554   end;
1555
1556 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1557   TbmpColorTableEnty = packed record
1558     b, g, r, a: Byte;
1559   end;
1560   TbmpColorTable = array of TbmpColorTableEnty;
1561   TbmpColorTableFormat = class(TFormatDescriptor)
1562   private
1563     fColorTable: TbmpColorTable;
1564   public
1565     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1566     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1567     property Range:      TglBitmapColorRec read fRange      write fRange;
1568     property Shift:      TShiftRec         read fShift      write fShift;
1569     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1570
1571     procedure CreateColorTable;
1572
1573     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1574     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1575     destructor Destroy; override;
1576   end;
1577
1578 const
1579   LUMINANCE_WEIGHT_R = 0.30;
1580   LUMINANCE_WEIGHT_G = 0.59;
1581   LUMINANCE_WEIGHT_B = 0.11;
1582
1583   ALPHA_WEIGHT_R = 0.30;
1584   ALPHA_WEIGHT_G = 0.59;
1585   ALPHA_WEIGHT_B = 0.11;
1586
1587   DEPTH_WEIGHT_R = 0.333333333;
1588   DEPTH_WEIGHT_G = 0.333333333;
1589   DEPTH_WEIGHT_B = 0.333333333;
1590
1591   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1592
1593   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1594     TfdEmpty,
1595
1596     TfdAlpha4,
1597     TfdAlpha8,
1598     TfdAlpha12,
1599     TfdAlpha16,
1600
1601     TfdLuminance4,
1602     TfdLuminance8,
1603     TfdLuminance12,
1604     TfdLuminance16,
1605
1606     TfdLuminance4Alpha4,
1607     TfdLuminance6Alpha2,
1608     TfdLuminance8Alpha8,
1609     TfdLuminance12Alpha4,
1610     TfdLuminance12Alpha12,
1611     TfdLuminance16Alpha16,
1612
1613     TfdR3G3B2,
1614     TfdRGB4,
1615     TfdR5G6B5,
1616     TfdRGB5,
1617     TfdRGB8,
1618     TfdRGB10,
1619     TfdRGB12,
1620     TfdRGB16,
1621
1622     TfdRGBA2,
1623     TfdRGBA4,
1624     TfdRGB5A1,
1625     TfdRGBA8,
1626     TfdRGB10A2,
1627     TfdRGBA12,
1628     TfdRGBA16,
1629
1630     TfdBGR4,
1631     TfdB5G6R5,
1632     TfdBGR5,
1633     TfdBGR8,
1634     TfdBGR10,
1635     TfdBGR12,
1636     TfdBGR16,
1637
1638     TfdBGRA2,
1639     TfdBGRA4,
1640     TfdBGR5A1,
1641     TfdBGRA8,
1642     TfdBGR10A2,
1643     TfdBGRA12,
1644     TfdBGRA16,
1645
1646     TfdDepth16,
1647     TfdDepth24,
1648     TfdDepth32,
1649
1650     TfdS3tcDtx1RGBA,
1651     TfdS3tcDtx3RGBA,
1652     TfdS3tcDtx5RGBA
1653   );
1654
1655 var
1656   FormatDescriptorCS: TCriticalSection;
1657   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1658
1659 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1660 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1661 begin
1662   result.Fields := [];
1663
1664   if X >= 0 then
1665     result.Fields := result.Fields + [ffX];
1666   if Y >= 0 then
1667     result.Fields := result.Fields + [ffY];
1668
1669   result.X := Max(0, X);
1670   result.Y := Max(0, Y);
1671 end;
1672
1673 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1674 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1675 begin
1676   result.r := r;
1677   result.g := g;
1678   result.b := b;
1679   result.a := a;
1680 end;
1681
1682 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1683 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1684 var
1685   i: Integer;
1686 begin
1687   result := false;
1688   for i := 0 to high(r1.arr) do
1689     if (r1.arr[i] <> r2.arr[i]) then
1690       exit;
1691   result := true;
1692 end;
1693
1694 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1695 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1696 begin
1697   result.r := r;
1698   result.g := g;
1699   result.b := b;
1700   result.a := a;
1701 end;
1702
1703 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1704 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1705 begin
1706   result := [];
1707
1708   if (aFormat in [
1709         //4 bbp
1710         tfLuminance4,
1711
1712         //8bpp
1713         tfR3G3B2, tfLuminance8,
1714
1715         //16bpp
1716         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1717         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1718
1719         //24bpp
1720         tfBGR8, tfRGB8,
1721
1722         //32bpp
1723         tfRGB10, tfRGB10A2, tfRGBA8,
1724         tfBGR10, tfBGR10A2, tfBGRA8]) then
1725     result := result + [ftBMP];
1726
1727   if (aFormat in [
1728         //8 bpp
1729         tfLuminance8, tfAlpha8,
1730
1731         //16 bpp
1732         tfLuminance16, tfLuminance8Alpha8,
1733         tfRGB5, tfRGB5A1, tfRGBA4,
1734         tfBGR5, tfBGR5A1, tfBGRA4,
1735
1736         //24 bpp
1737         tfRGB8, tfBGR8,
1738
1739         //32 bpp
1740         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1741     result := result + [ftTGA];
1742
1743   if (aFormat in [
1744         //8 bpp
1745         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1746         tfR3G3B2, tfRGBA2, tfBGRA2,
1747
1748         //16 bpp
1749         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1750         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1751         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1752
1753         //24 bpp
1754         tfRGB8, tfBGR8,
1755
1756         //32 bbp
1757         tfLuminance16Alpha16,
1758         tfRGBA8, tfRGB10A2,
1759         tfBGRA8, tfBGR10A2,
1760
1761         //compressed
1762         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1763     result := result + [ftDDS];
1764
1765   (* TODO
1766   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1767   if aFormat in [
1768     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1769     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1770     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1771     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1772     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1773     tfDepth16, tfDepth24, tfDepth32]
1774   then
1775     result := result + [ftPNG];
1776   {$ENDIF}
1777
1778   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1779   if Format in [
1780     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1781     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1782     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1783     tfDepth16, tfDepth24, tfDepth32]
1784   then
1785     result := result + [ftJPEG];
1786   {$ENDIF}
1787
1788   if aFormat in [
1789     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1790     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1791     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1792     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1793     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1794     tfDepth16, tfDepth24, tfDepth32]
1795   then
1796     result := result + [ftDDS, ftTGA, ftBMP];
1797   *)
1798 end;
1799
1800 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1801 function IsPowerOfTwo(aNumber: Integer): Boolean;
1802 begin
1803   while (aNumber and 1) = 0 do
1804     aNumber := aNumber shr 1;
1805   result := aNumber = 1;
1806 end;
1807
1808 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1809 function GetTopMostBit(aBitSet: UInt64): Integer;
1810 begin
1811   result := 0;
1812   while aBitSet > 0 do begin
1813     inc(result);
1814     aBitSet := aBitSet shr 1;
1815   end;
1816 end;
1817
1818 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1819 function CountSetBits(aBitSet: UInt64): Integer;
1820 begin
1821   result := 0;
1822   while aBitSet > 0 do begin
1823     if (aBitSet and 1) = 1 then
1824       inc(result);
1825     aBitSet := aBitSet shr 1;
1826   end;
1827 end;
1828
1829 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1830 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1831 begin
1832   result := Trunc(
1833     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1834     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1835     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1836 end;
1837
1838 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1839 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1840 begin
1841   result := Trunc(
1842     DEPTH_WEIGHT_R * aPixel.Data.r +
1843     DEPTH_WEIGHT_G * aPixel.Data.g +
1844     DEPTH_WEIGHT_B * aPixel.Data.b);
1845 end;
1846
1847 {$IFDEF GLB_NATIVE_OGL}
1848 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1849 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1850 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1851 var
1852   GL_LibHandle: Pointer = nil;
1853
1854 function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
1855 begin
1856   result :=  nil;
1857
1858   if not Assigned(aLibHandle) then
1859     aLibHandle := GL_LibHandle;
1860
1861 {$IF DEFINED(GLB_WIN)}
1862   result := GetProcAddress(HMODULE(aLibHandle), aProcName);
1863   if Assigned(result) then
1864     exit;
1865
1866   if Assigned(wglGetProcAddress) then
1867     result := wglGetProcAddress(aProcName);
1868 {$ELSEIF DEFINED(GLB_LINUX)}
1869   if Assigned(glXGetProcAddress) then begin
1870     result := glXGetProcAddress(aProcName);
1871     if Assigned(result) then
1872       exit;
1873   end;
1874
1875   if Assigned(glXGetProcAddressARB) then begin
1876     result := glXGetProcAddressARB(aProcName);
1877     if Assigned(result) then
1878       exit;
1879   end;
1880
1881   result := dlsym(aLibHandle, aProcName);
1882 {$ENDIF}
1883   if not Assigned(result) then
1884     raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
1885 end;
1886
1887 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1888 var
1889   GLU_LibHandle: Pointer = nil;
1890   OpenGLInitialized: Boolean;
1891   InitOpenGLCS: TCriticalSection;
1892
1893 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1894 procedure glbInitOpenGL;
1895
1896   ////////////////////////////////////////////////////////////////////////////////
1897   function glbLoadLibrary(const aName: PChar): Pointer;
1898   begin
1899     {$IF DEFINED(GLB_WIN)}
1900     result := Pointer(LoadLibrary(aName));
1901     {$ELSEIF DEFINED(GLB_LINUX)}
1902     result := dlopen(Name, RTLD_LAZY);
1903     {$ELSE}
1904     result := nil;
1905     {$ENDIF}
1906   end;
1907
1908   ////////////////////////////////////////////////////////////////////////////////
1909   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
1910   begin
1911     result := false;
1912     if not Assigned(aLibHandle) then
1913       exit;
1914
1915     {$IF DEFINED(GLB_WIN)}
1916     Result := FreeLibrary(HINST(aLibHandle));
1917     {$ELSEIF DEFINED(GLB_LINUX)}
1918     Result := dlclose(aLibHandle) = 0;
1919     {$ENDIF}
1920   end;
1921
1922 var
1923   p: Pointer;
1924 begin
1925   if Assigned(GL_LibHandle) then
1926     glbFreeLibrary(GL_LibHandle);
1927
1928   if Assigned(GLU_LibHandle) then
1929     glbFreeLibrary(GLU_LibHandle);
1930
1931   GL_LibHandle := glbLoadLibrary(libopengl);
1932   if not Assigned(GL_LibHandle) then
1933     raise EglBitmapException.Create('unable to load library: ' + libopengl);
1934
1935   GLU_LibHandle := glbLoadLibrary(libglu);
1936   if not Assigned(GLU_LibHandle) then
1937     raise EglBitmapException.Create('unable to load library: ' + libglu);
1938
1939   try
1940   {$IF DEFINED(GLB_WIN)}
1941     wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
1942   {$ELSEIF DEFINED(GLB_LINUX)}
1943     glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
1944     glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB');
1945   {$ENDIF}
1946
1947     glEnable := glbGetProcAddress('glEnable');
1948     glDisable := glbGetProcAddress('glDisable');
1949     glGetString := glbGetProcAddress('glGetString');
1950     glGetIntegerv := glbGetProcAddress('glGetIntegerv');
1951     glTexParameteri := glbGetProcAddress('glTexParameteri');
1952     glTexParameterfv := glbGetProcAddress('glTexParameterfv');
1953     glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
1954     glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
1955     glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
1956     glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
1957     glGenTextures := glbGetProcAddress('glGenTextures');
1958     glBindTexture := glbGetProcAddress('glBindTexture');
1959     glDeleteTextures := glbGetProcAddress('glDeleteTextures');
1960     glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
1961     glReadPixels := glbGetProcAddress('glReadPixels');
1962     glPixelStorei := glbGetProcAddress('glPixelStorei');
1963     glTexImage1D := glbGetProcAddress('glTexImage1D');
1964     glTexImage2D := glbGetProcAddress('glTexImage2D');
1965     glGetTexImage := glbGetProcAddress('glGetTexImage');
1966
1967     gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
1968     gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
1969   finally
1970     glbFreeLibrary(GL_LibHandle);
1971     glbFreeLibrary(GLU_LibHandle);
1972   end;
1973 end;
1974 {$ENDIF}
1975
1976 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1977 procedure glbReadOpenGLExtensions;
1978 var
1979   {$IFDEF GLB_DELPHI}
1980   Context: HGLRC;
1981   {$ENDIF}
1982   Buffer: AnsiString;
1983   MajorVersion, MinorVersion: Integer;
1984
1985   ///////////////////////////////////////////////////////////////////////////////////////////
1986   procedure TrimVersionString(Buffer: AnsiString; var Major, Minor: Integer);
1987   var
1988     Separator: Integer;
1989   begin
1990     Minor := 0;
1991     Major := 0;
1992
1993     Separator := Pos(AnsiString('.'), Buffer);
1994     if (Separator > 1) and (Separator < Length(Buffer)) and
1995        (Buffer[Separator - 1] in ['0'..'9']) and
1996        (Buffer[Separator + 1] in ['0'..'9']) then begin
1997
1998       Dec(Separator);
1999       while (Separator > 0) and (Buffer[Separator] in ['0'..'9']) do
2000         Dec(Separator);
2001
2002       Delete(Buffer, 1, Separator);
2003       Separator := Pos(AnsiString('.'), Buffer) + 1;
2004
2005       while (Separator <= Length(Buffer)) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do
2006         Inc(Separator);
2007
2008       Delete(Buffer, Separator, 255);
2009       Separator := Pos(AnsiString('.'), Buffer);
2010
2011       Major := StrToInt(Copy(String(Buffer), 1, Separator - 1));
2012       Minor := StrToInt(Copy(String(Buffer), Separator + 1, 1));
2013     end;
2014   end;
2015
2016   ///////////////////////////////////////////////////////////////////////////////////////////
2017   function CheckExtension(const Extension: AnsiString): Boolean;
2018   var
2019     ExtPos: Integer;
2020   begin
2021     ExtPos := Pos(Extension, Buffer);
2022     result := ExtPos > 0;
2023     if result then
2024       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2025   end;
2026
2027 begin
2028 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2029   InitOpenGLCS.Enter;
2030   try
2031     if not OpenGLInitialized then begin
2032       glbInitOpenGL;
2033       OpenGLInitialized := true;
2034     end;
2035   finally
2036     InitOpenGLCS.Leave;
2037   end;
2038 {$ENDIF}
2039
2040 {$IFDEF GLB_DELPHI}
2041   Context := wglGetCurrentContext;
2042   if (Context <> gLastContext) then begin
2043     gLastContext := Context;
2044 {$ENDIF}
2045
2046     // Version
2047     Buffer := glGetString(GL_VERSION);
2048     TrimVersionString(Buffer, MajorVersion, MinorVersion);
2049
2050     GL_VERSION_1_2 := false;
2051     GL_VERSION_1_3 := false;
2052     GL_VERSION_1_4 := false;
2053     GL_VERSION_2_0 := false;
2054     if MajorVersion = 1 then begin
2055       if MinorVersion >= 2 then
2056         GL_VERSION_1_2 := true;
2057
2058       if MinorVersion >= 3 then
2059         GL_VERSION_1_3 := true;
2060
2061       if MinorVersion >= 4 then
2062         GL_VERSION_1_4 := true;
2063     end else if MajorVersion >= 2 then begin
2064       GL_VERSION_1_2 := true;
2065       GL_VERSION_1_3 := true;
2066       GL_VERSION_1_4 := true;
2067       GL_VERSION_2_0 := true;
2068     end;
2069
2070     // Extensions
2071     Buffer := glGetString(GL_EXTENSIONS);
2072     GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2073     GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2074     GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2075     GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2076     GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2077     GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2078     GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2079     GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2080     GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2081     GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2082
2083     if GL_VERSION_1_3 then begin
2084       glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2085       glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2086       glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2087     end else begin
2088       glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB');
2089       glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB');
2090       glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
2091     end;
2092 {$IFDEF GLB_DELPHI}
2093   end;
2094 {$ENDIF}
2095 end;
2096 {$ENDIF}
2097
2098 (* TODO GLB_DELPHI
2099 {$IFDEF GLB_DELPHI}
2100 function CreateGrayPalette: HPALETTE;
2101 var
2102   Idx: Integer;
2103   Pal: PLogPalette;
2104 begin
2105   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
2106
2107   Pal.palVersion := $300;
2108   Pal.palNumEntries := 256;
2109
2110   {$IFOPT R+}
2111     {$DEFINE GLB_TEMPRANGECHECK}
2112     {$R-}
2113   {$ENDIF}
2114
2115   for Idx := 0 to 256 - 1 do begin
2116     Pal.palPalEntry[Idx].peRed   := Idx;
2117     Pal.palPalEntry[Idx].peGreen := Idx;
2118     Pal.palPalEntry[Idx].peBlue  := Idx;
2119     Pal.palPalEntry[Idx].peFlags := 0;
2120   end;
2121
2122   {$IFDEF GLB_TEMPRANGECHECK}
2123     {$UNDEF GLB_TEMPRANGECHECK}
2124     {$R+}
2125   {$ENDIF}
2126
2127   result := CreatePalette(Pal^);
2128
2129   FreeMem(Pal);
2130 end;
2131 {$ENDIF}
2132 *)
2133
2134 (* TODO GLB_SDL_IMAGE
2135 {$IFDEF GLB_SDL_IMAGE}
2136 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2137 begin
2138   result := TStream(context^.unknown.data1).Seek(offset, whence);
2139 end;
2140
2141 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2142 begin
2143   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2144 end;
2145
2146 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2147 begin
2148   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2149 end;
2150
2151 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2152 begin
2153   result := 0;
2154 end;
2155
2156 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2157 begin
2158   result := SDL_AllocRW;
2159
2160   if result = nil then
2161     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2162
2163   result^.seek := glBitmapRWseek;
2164   result^.read := glBitmapRWread;
2165   result^.write := glBitmapRWwrite;
2166   result^.close := glBitmapRWclose;
2167   result^.unknown.data1 := Stream;
2168 end;
2169 {$ENDIF}
2170 *)
2171
2172 (* TODO LoadFuncs
2173 function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
2174 var
2175   glBitmap: TglBitmap2D;
2176 begin
2177   result := false;
2178   Texture := 0;
2179
2180   {$IFDEF GLB_DELPHI}
2181   if Instance = 0 then
2182     Instance := HInstance;
2183
2184   if (LoadFromRes) then
2185     glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
2186   else
2187   {$ENDIF}
2188     glBitmap := TglBitmap2D.Create(FileName);
2189
2190   try
2191     glBitmap.DeleteTextureOnFree := false;
2192     glBitmap.FreeDataAfterGenTexture := false;
2193     glBitmap.GenTexture(true);
2194     if (glBitmap.ID > 0) then begin
2195       Texture := glBitmap.ID;
2196       result := true;
2197     end;
2198   finally
2199     glBitmap.Free;
2200   end;
2201 end;
2202
2203 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
2204 var
2205   CM: TglBitmapCubeMap;
2206 begin
2207   Texture := 0;
2208
2209   {$IFDEF GLB_DELPHI}
2210   if Instance = 0 then
2211     Instance := HInstance;
2212   {$ENDIF}
2213
2214   CM := TglBitmapCubeMap.Create;
2215   try
2216     CM.DeleteTextureOnFree := false;
2217
2218     // Maps
2219     {$IFDEF GLB_DELPHI}
2220     if (LoadFromRes) then
2221       CM.LoadFromResource(Instance, PositiveX)
2222     else
2223     {$ENDIF}
2224       CM.LoadFromFile(PositiveX);
2225     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
2226
2227     {$IFDEF GLB_DELPHI}
2228     if (LoadFromRes) then
2229       CM.LoadFromResource(Instance, NegativeX)
2230     else
2231     {$ENDIF}
2232       CM.LoadFromFile(NegativeX);
2233     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
2234
2235     {$IFDEF GLB_DELPHI}
2236     if (LoadFromRes) then
2237       CM.LoadFromResource(Instance, PositiveY)
2238     else
2239     {$ENDIF}
2240       CM.LoadFromFile(PositiveY);
2241     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
2242
2243     {$IFDEF GLB_DELPHI}
2244     if (LoadFromRes) then
2245       CM.LoadFromResource(Instance, NegativeY)
2246     else
2247     {$ENDIF}
2248       CM.LoadFromFile(NegativeY);
2249     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
2250
2251     {$IFDEF GLB_DELPHI}
2252     if (LoadFromRes) then
2253       CM.LoadFromResource(Instance, PositiveZ)
2254     else
2255     {$ENDIF}
2256       CM.LoadFromFile(PositiveZ);
2257     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
2258
2259     {$IFDEF GLB_DELPHI}
2260     if (LoadFromRes) then
2261       CM.LoadFromResource(Instance, NegativeZ)
2262     else
2263     {$ENDIF}
2264       CM.LoadFromFile(NegativeZ);
2265     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
2266
2267     Texture := CM.ID;
2268     result := true;
2269   finally
2270     CM.Free;
2271   end;
2272 end;
2273
2274 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
2275 var
2276   NM: TglBitmapNormalMap;
2277 begin
2278   Texture := 0;
2279
2280   NM := TglBitmapNormalMap.Create;
2281   try
2282     NM.DeleteTextureOnFree := false;
2283     NM.GenerateNormalMap(Size);
2284
2285     Texture := NM.ID;
2286     result := true;
2287   finally
2288     NM.Free;
2289   end;
2290 end;
2291 *)
2292
2293 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2294 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2295 begin
2296   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2297 end;
2298
2299 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2300 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2301 begin
2302   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2303 end;
2304
2305 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2306 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2307 begin
2308   glBitmapDefaultMipmap := aValue;
2309 end;
2310
2311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2312 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2313 begin
2314   glBitmapDefaultFormat := aFormat;
2315 end;
2316
2317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2318 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2319 begin
2320   glBitmapDefaultFilterMin := aMin;
2321   glBitmapDefaultFilterMag := aMag;
2322 end;
2323
2324 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2325 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2326 begin
2327   glBitmapDefaultWrapS := S;
2328   glBitmapDefaultWrapT := T;
2329   glBitmapDefaultWrapR := R;
2330 end;
2331
2332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2333 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2334 begin
2335   result := glBitmapDefaultDeleteTextureOnFree;
2336 end;
2337
2338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2339 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2340 begin
2341   result := glBitmapDefaultFreeDataAfterGenTextures;
2342 end;
2343
2344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2345 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2346 begin
2347   result := glBitmapDefaultMipmap;
2348 end;
2349
2350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2351 function glBitmapGetDefaultFormat: TglBitmapFormat;
2352 begin
2353   result := glBitmapDefaultFormat;
2354 end;
2355
2356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2357 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2358 begin
2359   aMin := glBitmapDefaultFilterMin;
2360   aMag := glBitmapDefaultFilterMag;
2361 end;
2362
2363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2364 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2365 begin
2366   S := glBitmapDefaultWrapS;
2367   T := glBitmapDefaultWrapT;
2368   R := glBitmapDefaultWrapR;
2369 end;
2370
2371 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2372 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2373 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2374 function TFormatDescriptor.GetRedMask: UInt64;
2375 begin
2376   result := fRange.r shl fShift.r;
2377 end;
2378
2379 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2380 function TFormatDescriptor.GetGreenMask: UInt64;
2381 begin
2382   result := fRange.g shl fShift.g;
2383 end;
2384
2385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2386 function TFormatDescriptor.GetBlueMask: UInt64;
2387 begin
2388   result := fRange.b shl fShift.b;
2389 end;
2390
2391 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2392 function TFormatDescriptor.GetAlphaMask: UInt64;
2393 begin
2394   result := fRange.a shl fShift.a;
2395 end;
2396
2397 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2398 function TFormatDescriptor.GetComponents: Integer;
2399 var
2400   i: Integer;
2401 begin
2402   result := 0;
2403   for i := 0 to 3 do
2404     if (fRange.arr[i] > 0) then
2405       inc(result);
2406 end;
2407
2408 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2409 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2410 var
2411   w, h: Integer;
2412 begin
2413   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2414     w := Max(1, aSize.X);
2415     h := Max(1, aSize.Y);
2416     result := GetSize(w, h);
2417   end else
2418     result := 0;
2419 end;
2420
2421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2422 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2423 begin
2424   result := 0;
2425   if (aWidth <= 0) or (aHeight <= 0) then
2426     exit;
2427   result := Ceil(aWidth * aHeight * fPixelSize);
2428 end;
2429
2430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2431 function TFormatDescriptor.CreateMappingData: Pointer;
2432 begin
2433   result := nil;
2434 end;
2435
2436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2437 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2438 begin
2439   //DUMMY
2440 end;
2441
2442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2443 function TFormatDescriptor.IsEmpty: Boolean;
2444 begin
2445   result := (fFormat = tfEmpty);
2446 end;
2447
2448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2449 function TFormatDescriptor.HasAlpha: Boolean;
2450 begin
2451   result := (fRange.a > 0);
2452 end;
2453
2454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2455 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean;
2456 begin
2457   result := false;
2458
2459   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2460     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2461
2462   if (aRedMask   <> RedMask) then
2463     exit;
2464   if (aGreenMask <> GreenMask) then
2465     exit;
2466   if (aBlueMask  <> BlueMask) then
2467     exit;
2468   if (aAlphaMask <> AlphaMask) then
2469     exit;
2470   result := true;
2471 end;
2472
2473 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2474 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2475 begin
2476   FillChar(aPixel, SizeOf(aPixel), 0);
2477   aPixel.Data   := fRange;
2478   aPixel.Range  := fRange;
2479   aPixel.Format := fFormat;
2480 end;
2481
2482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2483 constructor TFormatDescriptor.Create;
2484 begin
2485   inherited Create;
2486
2487   fFormat       := tfEmpty;
2488   fWithAlpha    := tfEmpty;
2489   fWithoutAlpha := tfEmpty;
2490   fRGBInverted  := tfEmpty;
2491   fUncompressed := tfEmpty;
2492   fPixelSize    := 0.0;
2493   fIsCompressed := false;
2494
2495   fglFormat         := 0;
2496   fglInternalFormat := 0;
2497   fglDataFormat     := 0;
2498
2499   FillChar(fRange, 0, SizeOf(fRange));
2500   FillChar(fShift, 0, SizeOf(fShift));
2501 end;
2502
2503 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2504 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2505 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2506 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2507 begin
2508   aData^ := aPixel.Data.a;
2509   inc(aData);
2510 end;
2511
2512 procedure TfdAlpha_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2513 begin
2514   aPixel.Data.r := 0;
2515   aPixel.Data.g := 0;
2516   aPixel.Data.b := 0;
2517   aPixel.Data.a := aData^;
2518   inc(aData^);
2519 end;
2520
2521 constructor TfdAlpha_UB1.Create;
2522 begin
2523   inherited Create;
2524   fPixelSize        := 1.0;
2525   fRange.a          := $FF;
2526   fglFormat         := GL_ALPHA;
2527   fglDataFormat     := GL_UNSIGNED_BYTE;
2528 end;
2529
2530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2531 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2532 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2533 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2534 begin
2535   aData^ := LuminanceWeight(aPixel);
2536   inc(aData);
2537 end;
2538
2539 procedure TfdLuminance_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2540 begin
2541   aPixel.Data.r := aData^;
2542   aPixel.Data.g := aData^;
2543   aPixel.Data.b := aData^;
2544   aPixel.Data.a := 0;
2545   inc(aData);
2546 end;
2547
2548 constructor TfdLuminance_UB1.Create;
2549 begin
2550   inherited Create;
2551   fPixelSize        := 1.0;
2552   fRange.r          := $FF;
2553   fRange.g          := $FF;
2554   fRange.b          := $FF;
2555   fglFormat         := GL_LUMINANCE;
2556   fglDataFormat     := GL_UNSIGNED_BYTE;
2557 end;
2558
2559 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2560 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2561 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2562 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2563 var
2564   i: Integer;
2565 begin
2566   aData^ := 0;
2567   for i := 0 to 3 do
2568     if (fRange.arr[i] > 0) then
2569       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2570   inc(aData);
2571 end;
2572
2573 procedure TfdUniversal_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2574 var
2575   i: Integer;
2576 begin
2577   for i := 0 to 3 do
2578     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2579   inc(aData);
2580 end;
2581
2582 constructor TfdUniversal_UB1.Create;
2583 begin
2584   inherited Create;
2585   fPixelSize := 1.0;
2586 end;
2587
2588 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2589 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2590 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2591 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2592 begin
2593   inherited Map(aPixel, aData, aMapData);
2594   aData^ := aPixel.Data.a;
2595   inc(aData);
2596 end;
2597
2598 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2599 begin
2600   inherited Unmap(aData, aPixel, aMapData);
2601   aPixel.Data.a := aData^;
2602   inc(aData);
2603 end;
2604
2605 constructor TfdLuminanceAlpha_UB2.Create;
2606 begin
2607   inherited Create;
2608   fPixelSize        := 2.0;
2609   fRange.a          := $FF;
2610   fShift.a          :=   8;
2611   fglFormat         := GL_LUMINANCE_ALPHA;
2612   fglDataFormat     := GL_UNSIGNED_BYTE;
2613 end;
2614
2615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2616 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2617 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2618 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2619 begin
2620   aData^ := aPixel.Data.r;
2621   inc(aData);
2622   aData^ := aPixel.Data.g;
2623   inc(aData);
2624   aData^ := aPixel.Data.b;
2625   inc(aData);
2626 end;
2627
2628 procedure TfdRGB_UB3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2629 begin
2630   aPixel.Data.r := aData^;
2631   inc(aData);
2632   aPixel.Data.g := aData^;
2633   inc(aData);
2634   aPixel.Data.b := aData^;
2635   inc(aData);
2636   aPixel.Data.a := 0;
2637 end;
2638
2639 constructor TfdRGB_UB3.Create;
2640 begin
2641   inherited Create;
2642   fPixelSize        := 3.0;
2643   fRange.r          := $FF;
2644   fRange.g          := $FF;
2645   fRange.b          := $FF;
2646   fShift.r          :=   0;
2647   fShift.g          :=   8;
2648   fShift.b          :=  16;
2649   fglFormat         := GL_RGB;
2650   fglDataFormat     := GL_UNSIGNED_BYTE;
2651 end;
2652
2653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2654 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2655 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2656 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2657 begin
2658   aData^ := aPixel.Data.b;
2659   inc(aData);
2660   aData^ := aPixel.Data.g;
2661   inc(aData);
2662   aData^ := aPixel.Data.r;
2663   inc(aData);
2664 end;
2665
2666 procedure TfdBGR_UB3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2667 begin
2668   aPixel.Data.b := aData^;
2669   inc(aData);
2670   aPixel.Data.g := aData^;
2671   inc(aData);
2672   aPixel.Data.r := aData^;
2673   inc(aData);
2674   aPixel.Data.a := 0;
2675 end;
2676
2677 constructor TfdBGR_UB3.Create;
2678 begin
2679   fPixelSize        := 3.0;
2680   fRange.r          := $FF;
2681   fRange.g          := $FF;
2682   fRange.b          := $FF;
2683   fShift.r          :=  16;
2684   fShift.g          :=   8;
2685   fShift.b          :=   0;
2686   fglFormat         := GL_BGR;
2687   fglDataFormat     := GL_UNSIGNED_BYTE;
2688 end;
2689
2690 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2691 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2692 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2693 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2694 begin
2695   inherited Map(aPixel, aData, aMapData);
2696   aData^ := aPixel.Data.a;
2697   inc(aData);
2698 end;
2699
2700 procedure TfdRGBA_UB4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2701 begin
2702   inherited Unmap(aData, aPixel, aMapData);
2703   aPixel.Data.a := aData^;
2704   inc(aData);
2705 end;
2706
2707 constructor TfdRGBA_UB4.Create;
2708 begin
2709   inherited Create;
2710   fPixelSize        := 4.0;
2711   fRange.a          := $FF;
2712   fShift.a          :=  24;
2713   fglFormat         := GL_RGBA;
2714   fglDataFormat     := GL_UNSIGNED_BYTE;
2715 end;
2716
2717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2718 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2720 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2721 begin
2722   inherited Map(aPixel, aData, aMapData);
2723   aData^ := aPixel.Data.a;
2724   inc(aData);
2725 end;
2726
2727 procedure TfdBGRA_UB4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2728 begin
2729   inherited Unmap(aData, aPixel, aMapData);
2730   aPixel.Data.a := aData^;
2731   inc(aData);
2732 end;
2733
2734 constructor TfdBGRA_UB4.Create;
2735 begin
2736   inherited Create;
2737   fPixelSize        := 4.0;
2738   fRange.a          := $FF;
2739   fShift.a          :=  24;
2740   fglFormat         := GL_BGRA;
2741   fglDataFormat     := GL_UNSIGNED_BYTE;
2742 end;
2743
2744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2745 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2747 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2748 begin
2749   PWord(aData)^ := aPixel.Data.a;
2750   inc(aData, 2);
2751 end;
2752
2753 procedure TfdAlpha_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2754 begin
2755   aPixel.Data.r := 0;
2756   aPixel.Data.g := 0;
2757   aPixel.Data.b := 0;
2758   aPixel.Data.a := PWord(aData)^;
2759   inc(aData, 2);
2760 end;
2761
2762 constructor TfdAlpha_US1.Create;
2763 begin
2764   inherited Create;
2765   fPixelSize        := 2.0;
2766   fRange.a          := $FFFF;
2767   fglFormat         := GL_ALPHA;
2768   fglDataFormat     := GL_UNSIGNED_SHORT;
2769 end;
2770
2771 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2772 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2774 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2775 begin
2776   PWord(aData)^ := LuminanceWeight(aPixel);
2777   inc(aData, 2);
2778 end;
2779
2780 procedure TfdLuminance_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2781 begin
2782   aPixel.Data.r := PWord(aData)^;
2783   aPixel.Data.g := PWord(aData)^;
2784   aPixel.Data.b := PWord(aData)^;
2785   aPixel.Data.a := 0;
2786   inc(aData, 2);
2787 end;
2788
2789 constructor TfdLuminance_US1.Create;
2790 begin
2791   inherited Create;
2792   fPixelSize        := 2.0;
2793   fRange.r          := $FFFF;
2794   fRange.g          := $FFFF;
2795   fRange.b          := $FFFF;
2796   fglFormat         := GL_LUMINANCE;
2797   fglDataFormat     := GL_UNSIGNED_SHORT;
2798 end;
2799
2800 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2801 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2802 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2803 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2804 var
2805   i: Integer;
2806 begin
2807   PWord(aData)^ := 0;
2808   for i := 0 to 3 do
2809     if (fRange.arr[i] > 0) then
2810       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2811   inc(aData, 2);
2812 end;
2813
2814 procedure TfdUniversal_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2815 var
2816   i: Integer;
2817 begin
2818   for i := 0 to 3 do
2819     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2820   inc(aData, 2);
2821 end;
2822
2823 constructor TfdUniversal_US1.Create;
2824 begin
2825   inherited Create;
2826   fPixelSize := 2.0;
2827 end;
2828
2829 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2830 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2831 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2832 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2833 begin
2834   PWord(aData)^ := DepthWeight(aPixel);
2835   inc(aData, 2);
2836 end;
2837
2838 procedure TfdDepth_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2839 begin
2840   aPixel.Data.r := PWord(aData)^;
2841   aPixel.Data.g := PWord(aData)^;
2842   aPixel.Data.b := PWord(aData)^;
2843   aPixel.Data.a := 0;
2844   inc(aData, 2);
2845 end;
2846
2847 constructor TfdDepth_US1.Create;
2848 begin
2849   inherited Create;
2850   fPixelSize        := 2.0;
2851   fRange.r          := $FFFF;
2852   fRange.g          := $FFFF;
2853   fRange.b          := $FFFF;
2854   fglFormat         := GL_DEPTH_COMPONENT;
2855   fglDataFormat     := GL_UNSIGNED_SHORT;
2856 end;
2857
2858 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2859 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2860 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2861 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2862 begin
2863   inherited Map(aPixel, aData, aMapData);
2864   PWord(aData)^ := aPixel.Data.a;
2865   inc(aData, 2);
2866 end;
2867
2868 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2869 begin
2870   inherited Unmap(aData, aPixel, aMapData);
2871   aPixel.Data.a := PWord(aData)^;
2872   inc(aData, 2);
2873 end;
2874
2875 constructor TfdLuminanceAlpha_US2.Create;
2876 begin
2877   inherited Create;
2878   fPixelSize        :=   4.0;
2879   fRange.a          := $FFFF;
2880   fShift.a          :=    16;
2881   fglFormat         := GL_LUMINANCE_ALPHA;
2882   fglDataFormat     := GL_UNSIGNED_SHORT;
2883 end;
2884
2885 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2886 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2887 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2888 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2889 begin
2890   PWord(aData)^ := aPixel.Data.r;
2891   inc(aData, 2);
2892   PWord(aData)^ := aPixel.Data.g;
2893   inc(aData, 2);
2894   PWord(aData)^ := aPixel.Data.b;
2895   inc(aData, 2);
2896 end;
2897
2898 procedure TfdRGB_US3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2899 begin
2900   aPixel.Data.r := PWord(aData)^;
2901   inc(aData, 2);
2902   aPixel.Data.g := PWord(aData)^;
2903   inc(aData, 2);
2904   aPixel.Data.b := PWord(aData)^;
2905   inc(aData, 2);
2906   aPixel.Data.a := 0;
2907 end;
2908
2909 constructor TfdRGB_US3.Create;
2910 begin
2911   inherited Create;
2912   fPixelSize        :=   6.0;
2913   fRange.r          := $FFFF;
2914   fRange.g          := $FFFF;
2915   fRange.b          := $FFFF;
2916   fShift.r          :=     0;
2917   fShift.g          :=    16;
2918   fShift.b          :=    32;
2919   fglFormat         := GL_RGB;
2920   fglDataFormat     := GL_UNSIGNED_SHORT;
2921 end;
2922
2923 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2924 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2925 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2926 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2927 begin
2928   PWord(aData)^ := aPixel.Data.b;
2929   inc(aData, 2);
2930   PWord(aData)^ := aPixel.Data.g;
2931   inc(aData, 2);
2932   PWord(aData)^ := aPixel.Data.r;
2933   inc(aData, 2);
2934 end;
2935
2936 procedure TfdBGR_US3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2937 begin
2938   aPixel.Data.b := PWord(aData)^;
2939   inc(aData, 2);
2940   aPixel.Data.g := PWord(aData)^;
2941   inc(aData, 2);
2942   aPixel.Data.r := PWord(aData)^;
2943   inc(aData, 2);
2944   aPixel.Data.a := 0;
2945 end;
2946
2947 constructor TfdBGR_US3.Create;
2948 begin
2949   inherited Create;
2950   fPixelSize        :=   6.0;
2951   fRange.r          := $FFFF;
2952   fRange.g          := $FFFF;
2953   fRange.b          := $FFFF;
2954   fShift.r          :=    32;
2955   fShift.g          :=    16;
2956   fShift.b          :=     0;
2957   fglFormat         := GL_BGR;
2958   fglDataFormat     := GL_UNSIGNED_SHORT;
2959 end;
2960
2961 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2962 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2963 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2964 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2965 begin
2966   inherited Map(aPixel, aData, aMapData);
2967   PWord(aData)^ := aPixel.Data.a;
2968   inc(aData, 2);
2969 end;
2970
2971 procedure TfdRGBA_US4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2972 begin
2973   inherited Unmap(aData, aPixel, aMapData);
2974   aPixel.Data.a := PWord(aData)^;
2975   inc(aData, 2);
2976 end;
2977
2978 constructor TfdRGBA_US4.Create;
2979 begin
2980   inherited Create;
2981   fPixelSize        :=   8.0;
2982   fRange.a          := $FFFF;
2983   fShift.a          :=    48;
2984   fglFormat         := GL_RGBA;
2985   fglDataFormat     := GL_UNSIGNED_SHORT;
2986 end;
2987
2988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2989 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2990 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2991 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2992 begin
2993   inherited Map(aPixel, aData, aMapData);
2994   PWord(aData)^ := aPixel.Data.a;
2995   inc(aData, 2);
2996 end;
2997
2998 procedure TfdBGRA_US4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2999 begin
3000   inherited Unmap(aData, aPixel, aMapData);
3001   aPixel.Data.a := PWord(aData)^;
3002   inc(aData, 2);
3003 end;
3004
3005 constructor TfdBGRA_US4.Create;
3006 begin
3007   inherited Create;
3008   fPixelSize        :=   8.0;
3009   fRange.a          := $FFFF;
3010   fShift.a          :=    48;
3011   fglFormat         := GL_BGRA;
3012   fglDataFormat     := GL_UNSIGNED_SHORT;
3013 end;
3014
3015 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3016 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3017 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3018 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3019 var
3020   i: Integer;
3021 begin
3022   PCardinal(aData)^ := 0;
3023   for i := 0 to 3 do
3024     if (fRange.arr[i] > 0) then
3025       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
3026   inc(aData, 4);
3027 end;
3028
3029 procedure TfdUniversal_UI1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
3030 var
3031   i: Integer;
3032 begin
3033   for i := 0 to 3 do
3034     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
3035   inc(aData, 2);
3036 end;
3037
3038 constructor TfdUniversal_UI1.Create;
3039 begin
3040   inherited Create;
3041   fPixelSize := 4.0;
3042 end;
3043
3044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3045 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3046 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3047 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3048 begin
3049   PCardinal(aData)^ := DepthWeight(aPixel);
3050   inc(aData, 4);
3051 end;
3052
3053 procedure TfdDepth_UI1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
3054 begin
3055   aPixel.Data.r := PCardinal(aData)^;
3056   aPixel.Data.g := PCardinal(aData)^;
3057   aPixel.Data.b := PCardinal(aData)^;
3058   aPixel.Data.a := 0;
3059   inc(aData, 4);
3060 end;
3061
3062 constructor TfdDepth_UI1.Create;
3063 begin
3064   inherited Create;
3065   fPixelSize        := 4.0;
3066   fRange.r          := $FFFFFFFF;
3067   fRange.g          := $FFFFFFFF;
3068   fRange.b          := $FFFFFFFF;
3069   fglFormat         := GL_DEPTH_COMPONENT;
3070   fglDataFormat     := GL_UNSIGNED_INT;
3071 end;
3072
3073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3076 constructor TfdAlpha4.Create;
3077 begin
3078   inherited Create;
3079   fFormat           := tfAlpha4;
3080   fWithAlpha        := tfAlpha4;
3081   fglInternalFormat := GL_ALPHA4;
3082 end;
3083
3084 constructor TfdAlpha8.Create;
3085 begin
3086   inherited Create;
3087   fFormat           := tfAlpha8;
3088   fWithAlpha        := tfAlpha8;
3089   fglInternalFormat := GL_ALPHA8;
3090 end;
3091
3092 constructor TfdAlpha12.Create;
3093 begin
3094   inherited Create;
3095   fFormat           := tfAlpha12;
3096   fWithAlpha        := tfAlpha12;
3097   fglInternalFormat := GL_ALPHA12;
3098 end;
3099
3100 constructor TfdAlpha16.Create;
3101 begin
3102   inherited Create;
3103   fFormat           := tfAlpha16;
3104   fWithAlpha        := tfAlpha16;
3105   fglInternalFormat := GL_ALPHA16;
3106 end;
3107
3108 constructor TfdLuminance4.Create;
3109 begin
3110   inherited Create;
3111   fFormat           := tfLuminance4;
3112   fWithAlpha        := tfLuminance4Alpha4;
3113   fWithoutAlpha     := tfLuminance4;
3114   fglInternalFormat := GL_LUMINANCE4;
3115 end;
3116
3117 constructor TfdLuminance8.Create;
3118 begin
3119   inherited Create;
3120   fFormat           := tfLuminance8;
3121   fWithAlpha        := tfLuminance8Alpha8;
3122   fWithoutAlpha     := tfLuminance8;
3123   fglInternalFormat := GL_LUMINANCE8;
3124 end;
3125
3126 constructor TfdLuminance12.Create;
3127 begin
3128   inherited Create;
3129   fFormat           := tfLuminance12;
3130   fWithAlpha        := tfLuminance12Alpha12;
3131   fWithoutAlpha     := tfLuminance12;
3132   fglInternalFormat := GL_LUMINANCE12;
3133 end;
3134
3135 constructor TfdLuminance16.Create;
3136 begin
3137   inherited Create;
3138   fFormat           := tfLuminance16;
3139   fWithAlpha        := tfLuminance16Alpha16;
3140   fWithoutAlpha     := tfLuminance16;
3141   fglInternalFormat := GL_LUMINANCE16;
3142 end;
3143
3144 constructor TfdLuminance4Alpha4.Create;
3145 begin
3146   inherited Create;
3147   fFormat           := tfLuminance4Alpha4;
3148   fWithAlpha        := tfLuminance4Alpha4;
3149   fWithoutAlpha     := tfLuminance4;
3150   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3151 end;
3152
3153 constructor TfdLuminance6Alpha2.Create;
3154 begin
3155   inherited Create;
3156   fFormat           := tfLuminance6Alpha2;
3157   fWithAlpha        := tfLuminance6Alpha2;
3158   fWithoutAlpha     := tfLuminance8;
3159   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3160 end;
3161
3162 constructor TfdLuminance8Alpha8.Create;
3163 begin
3164   inherited Create;
3165   fFormat           := tfLuminance8Alpha8;
3166   fWithAlpha        := tfLuminance8Alpha8;
3167   fWithoutAlpha     := tfLuminance8;
3168   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3169 end;
3170
3171 constructor TfdLuminance12Alpha4.Create;
3172 begin
3173   inherited Create;
3174   fFormat           := tfLuminance12Alpha4;
3175   fWithAlpha        := tfLuminance12Alpha4;
3176   fWithoutAlpha     := tfLuminance12;
3177   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3178 end;
3179
3180 constructor TfdLuminance12Alpha12.Create;
3181 begin
3182   inherited Create;
3183   fFormat           := tfLuminance12Alpha12;
3184   fWithAlpha        := tfLuminance12Alpha12;
3185   fWithoutAlpha     := tfLuminance12;
3186   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3187 end;
3188
3189 constructor TfdLuminance16Alpha16.Create;
3190 begin
3191   inherited Create;
3192   fFormat           := tfLuminance16Alpha16;
3193   fWithAlpha        := tfLuminance16Alpha16;
3194   fWithoutAlpha     := tfLuminance16;
3195   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3196 end;
3197
3198 constructor TfdR3G3B2.Create;
3199 begin
3200   inherited Create;
3201   fFormat           := tfR3G3B2;
3202   fWithAlpha        := tfRGBA2;
3203   fWithoutAlpha     := tfR3G3B2;
3204   fRange.r          := $7;
3205   fRange.g          := $7;
3206   fRange.b          := $3;
3207   fShift.r          :=  0;
3208   fShift.g          :=  3;
3209   fShift.b          :=  6;
3210   fglFormat         := GL_RGB;
3211   fglInternalFormat := GL_R3_G3_B2;
3212   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3213 end;
3214
3215 constructor TfdRGB4.Create;
3216 begin
3217   inherited Create;
3218   fFormat           := tfRGB4;
3219   fWithAlpha        := tfRGBA4;
3220   fWithoutAlpha     := tfRGB4;
3221   fRGBInverted      := tfBGR4;
3222   fRange.r          := $F;
3223   fRange.g          := $F;
3224   fRange.b          := $F;
3225   fShift.r          :=  0;
3226   fShift.g          :=  4;
3227   fShift.b          :=  8;
3228   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3229   fglInternalFormat := GL_RGB4;
3230   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3231 end;
3232
3233 constructor TfdR5G6B5.Create;
3234 begin
3235   inherited Create;
3236   fFormat           := tfR5G6B5;
3237   fWithAlpha        := tfRGBA4;
3238   fWithoutAlpha     := tfR5G6B5;
3239   fRGBInverted      := tfB5G6R5;
3240   fRange.r          := $1F;
3241   fRange.g          := $3F;
3242   fRange.b          := $1F;
3243   fShift.r          :=   0;
3244   fShift.g          :=   5;
3245   fShift.b          :=  11;
3246   fglFormat         := GL_RGB;
3247   fglInternalFormat := GL_RGB565;
3248   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3249 end;
3250
3251 constructor TfdRGB5.Create;
3252 begin
3253   inherited Create;
3254   fFormat           := tfRGB5;
3255   fWithAlpha        := tfRGB5A1;
3256   fWithoutAlpha     := tfRGB5;
3257   fRGBInverted      := tfBGR5;
3258   fRange.r          := $1F;
3259   fRange.g          := $1F;
3260   fRange.b          := $1F;
3261   fShift.r          :=   0;
3262   fShift.g          :=   5;
3263   fShift.b          :=  10;
3264   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3265   fglInternalFormat := GL_RGB5;
3266   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3267 end;
3268
3269 constructor TfdRGB8.Create;
3270 begin
3271   inherited Create;
3272   fFormat           := tfRGB8;
3273   fWithAlpha        := tfRGBA8;
3274   fWithoutAlpha     := tfRGB8;
3275   fRGBInverted      := tfBGR8;
3276   fglInternalFormat := GL_RGB8;
3277 end;
3278
3279 constructor TfdRGB10.Create;
3280 begin
3281   inherited Create;
3282   fFormat           := tfRGB10;
3283   fWithAlpha        := tfRGB10A2;
3284   fWithoutAlpha     := tfRGB10;
3285   fRGBInverted      := tfBGR10;
3286   fRange.r          := $3FF;
3287   fRange.g          := $3FF;
3288   fRange.b          := $3FF;
3289   fShift.r          :=    0;
3290   fShift.g          :=   10;
3291   fShift.b          :=   20;
3292   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3293   fglInternalFormat := GL_RGB10;
3294   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3295 end;
3296
3297 constructor TfdRGB12.Create;
3298 begin
3299   inherited Create;
3300   fFormat           := tfRGB12;
3301   fWithAlpha        := tfRGBA12;
3302   fWithoutAlpha     := tfRGB12;
3303   fRGBInverted      := tfBGR12;
3304   fglInternalFormat := GL_RGB12;
3305 end;
3306
3307 constructor TfdRGB16.Create;
3308 begin
3309   inherited Create;
3310   fFormat           := tfRGB16;
3311   fWithAlpha        := tfRGBA16;
3312   fWithoutAlpha     := tfRGB16;
3313   fRGBInverted      := tfBGR16;
3314   fglInternalFormat := GL_RGB16;
3315 end;
3316
3317 constructor TfdRGBA2.Create;
3318 begin
3319   inherited Create;
3320   fFormat           := tfRGBA2;
3321   fWithAlpha        := tfRGBA2;
3322   fWithoutAlpha     := tfR3G3B2;
3323   fRGBInverted      := tfBGRA2;
3324   fglInternalFormat := GL_RGBA2;
3325 end;
3326
3327 constructor TfdRGBA4.Create;
3328 begin
3329   inherited Create;
3330   fFormat           := tfRGBA4;
3331   fWithAlpha        := tfRGBA4;
3332   fWithoutAlpha     := tfRGB4;
3333   fRGBInverted      := tfBGRA4;
3334   fRange.r          := $F;
3335   fRange.g          := $F;
3336   fRange.b          := $F;
3337   fRange.a          := $F;
3338   fShift.r          :=  0;
3339   fShift.g          :=  4;
3340   fShift.b          :=  8;
3341   fShift.a          := 12;
3342   fglFormat         := GL_RGBA;
3343   fglInternalFormat := GL_RGBA4;
3344   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3345 end;
3346
3347 constructor TfdRGB5A1.Create;
3348 begin
3349   inherited Create;
3350   fFormat           := tfRGB5A1;
3351   fWithAlpha        := tfRGB5A1;
3352   fWithoutAlpha     := tfRGB5;
3353   fRGBInverted      := tfBGR5A1;
3354   fRange.r          := $1F;
3355   fRange.g          := $1F;
3356   fRange.b          := $1F;
3357   fRange.a          := $01;
3358   fShift.r          :=   0;
3359   fShift.g          :=   5;
3360   fShift.b          :=  10;
3361   fShift.a          :=  15;
3362   fglFormat         := GL_RGBA;
3363   fglInternalFormat := GL_RGB5_A1;
3364   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3365 end;
3366
3367 constructor TfdRGBA8.Create;
3368 begin
3369   inherited Create;
3370   fFormat           := tfRGBA8;
3371   fWithAlpha        := tfRGBA8;
3372   fWithoutAlpha     := tfRGB8;
3373   fRGBInverted      := tfBGRA8;
3374   fglInternalFormat := GL_RGBA8;
3375 end;
3376
3377 constructor TfdRGB10A2.Create;
3378 begin
3379   inherited Create;
3380   fFormat           := tfRGB10A2;
3381   fWithAlpha        := tfRGB10A2;
3382   fWithoutAlpha     := tfRGB10;
3383   fRGBInverted      := tfBGR10A2;
3384   fRange.r          := $3FF;
3385   fRange.g          := $3FF;
3386   fRange.b          := $3FF;
3387   fRange.a          := $003;
3388   fShift.r          :=    0;
3389   fShift.g          :=   10;
3390   fShift.b          :=   20;
3391   fShift.a          :=   30;
3392   fglFormat         := GL_RGBA;
3393   fglInternalFormat := GL_RGB10_A2;
3394   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3395 end;
3396
3397 constructor TfdRGBA12.Create;
3398 begin
3399   inherited Create;
3400   fFormat           := tfRGBA12;
3401   fWithAlpha        := tfRGBA12;
3402   fWithoutAlpha     := tfRGB12;
3403   fRGBInverted      := tfBGRA12;
3404   fglInternalFormat := GL_RGBA12;
3405 end;
3406
3407 constructor TfdRGBA16.Create;
3408 begin
3409   inherited Create;
3410   fFormat           := tfRGBA16;
3411   fWithAlpha        := tfRGBA16;
3412   fWithoutAlpha     := tfRGB16;
3413   fRGBInverted      := tfBGRA16;
3414   fglInternalFormat := GL_RGBA16;
3415 end;
3416
3417 constructor TfdBGR4.Create;
3418 begin
3419   inherited Create;
3420   fPixelSize        := 2.0;
3421   fFormat           := tfBGR4;
3422   fWithAlpha        := tfBGRA4;
3423   fWithoutAlpha     := tfBGR4;
3424   fRGBInverted      := tfRGB4;
3425   fRange.r          := $F;
3426   fRange.g          := $F;
3427   fRange.b          := $F;
3428   fRange.a          := $0;
3429   fShift.r          :=  8;
3430   fShift.g          :=  4;
3431   fShift.b          :=  0;
3432   fShift.a          :=  0;
3433   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3434   fglInternalFormat := GL_RGB4;
3435   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3436 end;
3437
3438 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3440 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3441 constructor TfdB5G6R5.Create;
3442 begin
3443   inherited Create;
3444   fFormat           := tfB5G6R5;
3445   fWithAlpha        := tfBGRA4;
3446   fWithoutAlpha     := tfB5G6R5;
3447   fRGBInverted      := tfR5G6B5;
3448   fRange.r          := $1F;
3449   fRange.g          := $3F;
3450   fRange.b          := $1F;
3451   fShift.r          :=  11;
3452   fShift.g          :=   5;
3453   fShift.b          :=   0;
3454   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3455   fglInternalFormat := GL_RGB8;
3456   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3457 end;
3458
3459 constructor TfdBGR5.Create;
3460 begin
3461   inherited Create;
3462   fPixelSize        := 2.0;
3463   fFormat           := tfBGR5;
3464   fWithAlpha        := tfBGR5A1;
3465   fWithoutAlpha     := tfBGR5;
3466   fRGBInverted      := tfRGB5;
3467   fRange.r          := $1F;
3468   fRange.g          := $1F;
3469   fRange.b          := $1F;
3470   fRange.a          := $00;
3471   fShift.r          :=  10;
3472   fShift.g          :=   5;
3473   fShift.b          :=   0;
3474   fShift.a          :=   0;
3475   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3476   fglInternalFormat := GL_RGB5;
3477   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3478 end;
3479
3480 constructor TfdBGR8.Create;
3481 begin
3482   inherited Create;
3483   fFormat           := tfBGR8;
3484   fWithAlpha        := tfBGRA8;
3485   fWithoutAlpha     := tfBGR8;
3486   fRGBInverted      := tfRGB8;
3487   fglInternalFormat := GL_RGB8;
3488 end;
3489
3490 constructor TfdBGR10.Create;
3491 begin
3492   inherited Create;
3493   fFormat           := tfBGR10;
3494   fWithAlpha        := tfBGR10A2;
3495   fWithoutAlpha     := tfBGR10;
3496   fRGBInverted      := tfRGB10;
3497   fRange.r          := $3FF;
3498   fRange.g          := $3FF;
3499   fRange.b          := $3FF;
3500   fRange.a          := $000;
3501   fShift.r          :=   20;
3502   fShift.g          :=   10;
3503   fShift.b          :=    0;
3504   fShift.a          :=    0;
3505   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3506   fglInternalFormat := GL_RGB10;
3507   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3508 end;
3509
3510 constructor TfdBGR12.Create;
3511 begin
3512   inherited Create;
3513   fFormat           := tfBGR12;
3514   fWithAlpha        := tfBGRA12;
3515   fWithoutAlpha     := tfBGR12;
3516   fRGBInverted      := tfRGB12;
3517   fglInternalFormat := GL_RGB12;
3518 end;
3519
3520 constructor TfdBGR16.Create;
3521 begin
3522   inherited Create;
3523   fFormat           := tfBGR16;
3524   fWithAlpha        := tfBGRA16;
3525   fWithoutAlpha     := tfBGR16;
3526   fRGBInverted      := tfRGB16;
3527   fglInternalFormat := GL_RGB16;
3528 end;
3529
3530 constructor TfdBGRA2.Create;
3531 begin
3532   inherited Create;
3533   fFormat           := tfBGRA2;
3534   fWithAlpha        := tfBGRA4;
3535   fWithoutAlpha     := tfBGR4;
3536   fRGBInverted      := tfRGBA2;
3537   fglInternalFormat := GL_RGBA2;
3538 end;
3539
3540 constructor TfdBGRA4.Create;
3541 begin
3542   inherited Create;
3543   fFormat           := tfBGRA4;
3544   fWithAlpha        := tfBGRA4;
3545   fWithoutAlpha     := tfBGR4;
3546   fRGBInverted      := tfRGBA4;
3547   fRange.r          := $F;
3548   fRange.g          := $F;
3549   fRange.b          := $F;
3550   fRange.a          := $F;
3551   fShift.r          :=  8;
3552   fShift.g          :=  4;
3553   fShift.b          :=  0;
3554   fShift.a          := 12;
3555   fglFormat         := GL_BGRA;
3556   fglInternalFormat := GL_RGBA4;
3557   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3558 end;
3559
3560 constructor TfdBGR5A1.Create;
3561 begin
3562   inherited Create;
3563   fFormat           := tfBGR5A1;
3564   fWithAlpha        := tfBGR5A1;
3565   fWithoutAlpha     := tfBGR5;
3566   fRGBInverted      := tfRGB5A1;
3567   fRange.r          := $1F;
3568   fRange.g          := $1F;
3569   fRange.b          := $1F;
3570   fRange.a          := $01;
3571   fShift.r          :=  10;
3572   fShift.g          :=   5;
3573   fShift.b          :=   0;
3574   fShift.a          :=  15;
3575   fglFormat         := GL_BGRA;
3576   fglInternalFormat := GL_RGB5_A1;
3577   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3578 end;
3579
3580 constructor TfdBGRA8.Create;
3581 begin
3582   inherited Create;
3583   fFormat           := tfBGRA8;
3584   fWithAlpha        := tfBGRA8;
3585   fWithoutAlpha     := tfBGR8;
3586   fRGBInverted      := tfRGBA8;
3587   fglInternalFormat := GL_RGBA8;
3588 end;
3589
3590 constructor TfdBGR10A2.Create;
3591 begin
3592   inherited Create;
3593   fFormat           := tfBGR10A2;
3594   fWithAlpha        := tfBGR10A2;
3595   fWithoutAlpha     := tfBGR10;
3596   fRGBInverted      := tfRGB10A2;
3597   fRange.r          := $3FF;
3598   fRange.g          := $3FF;
3599   fRange.b          := $3FF;
3600   fRange.a          := $003;
3601   fShift.r          :=   20;
3602   fShift.g          :=   10;
3603   fShift.b          :=    0;
3604   fShift.a          :=   30;
3605   fglFormat         := GL_BGRA;
3606   fglInternalFormat := GL_RGB10_A2;
3607   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3608 end;
3609
3610 constructor TfdBGRA12.Create;
3611 begin
3612   inherited Create;
3613   fFormat           := tfBGRA12;
3614   fWithAlpha        := tfBGRA12;
3615   fWithoutAlpha     := tfBGR12;
3616   fRGBInverted      := tfRGBA12;
3617   fglInternalFormat := GL_RGBA12;
3618 end;
3619
3620 constructor TfdBGRA16.Create;
3621 begin
3622   inherited Create;
3623   fFormat           := tfBGRA16;
3624   fWithAlpha        := tfBGRA16;
3625   fWithoutAlpha     := tfBGR16;
3626   fRGBInverted      := tfRGBA16;
3627   fglInternalFormat := GL_RGBA16;
3628 end;
3629
3630 constructor TfdDepth16.Create;
3631 begin
3632   inherited Create;
3633   fFormat           := tfDepth16;
3634   fWithAlpha        := tfEmpty;
3635   fWithoutAlpha     := tfDepth16;
3636   fglInternalFormat := GL_DEPTH_COMPONENT16;
3637 end;
3638
3639 constructor TfdDepth24.Create;
3640 begin
3641   inherited Create;
3642   fFormat           := tfDepth24;
3643   fWithAlpha        := tfEmpty;
3644   fWithoutAlpha     := tfDepth24;
3645   fglInternalFormat := GL_DEPTH_COMPONENT24;
3646 end;
3647
3648 constructor TfdDepth32.Create;
3649 begin
3650   inherited Create;
3651   fFormat           := tfDepth32;
3652   fWithAlpha        := tfEmpty;
3653   fWithoutAlpha     := tfDepth32;
3654   fglInternalFormat := GL_DEPTH_COMPONENT32;
3655 end;
3656
3657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3658 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3659 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3660 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3661 begin
3662   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3663 end;
3664
3665 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
3666 begin
3667   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3668 end;
3669
3670 constructor TfdS3tcDtx1RGBA.Create;
3671 begin
3672   inherited Create;
3673   fFormat           := tfS3tcDtx1RGBA;
3674   fWithAlpha        := tfS3tcDtx1RGBA;
3675   fUncompressed     := tfRGB5A1;
3676   fPixelSize        := 0.5;
3677   fIsCompressed     := true;
3678   fglFormat         := GL_COMPRESSED_RGBA;
3679   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3680   fglDataFormat     := GL_UNSIGNED_BYTE;
3681 end;
3682
3683 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3684 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3686 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3687 begin
3688   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3689 end;
3690
3691 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
3692 begin
3693   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3694 end;
3695
3696 constructor TfdS3tcDtx3RGBA.Create;
3697 begin
3698   inherited Create;
3699   fFormat           := tfS3tcDtx3RGBA;
3700   fWithAlpha        := tfS3tcDtx3RGBA;
3701   fUncompressed     := tfRGBA8;
3702   fPixelSize        := 1.0;
3703   fIsCompressed     := true;
3704   fglFormat         := GL_COMPRESSED_RGBA;
3705   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3706   fglDataFormat     := GL_UNSIGNED_BYTE;
3707 end;
3708
3709 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3710 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3711 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3712 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3713 begin
3714   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3715 end;
3716
3717 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
3718 begin
3719   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3720 end;
3721
3722 constructor TfdS3tcDtx5RGBA.Create;
3723 begin
3724   inherited Create;
3725   fFormat           := tfS3tcDtx3RGBA;
3726   fWithAlpha        := tfS3tcDtx3RGBA;
3727   fUncompressed     := tfRGBA8;
3728   fPixelSize        := 1.0;
3729   fIsCompressed     := true;
3730   fglFormat         := GL_COMPRESSED_RGBA;
3731   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3732   fglDataFormat     := GL_UNSIGNED_BYTE;
3733 end;
3734
3735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3736 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3737 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3738 class procedure TFormatDescriptor.Init;
3739 begin
3740   if not Assigned(FormatDescriptorCS) then
3741     FormatDescriptorCS := TCriticalSection.Create;
3742 end;
3743
3744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3745 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3746 begin
3747   FormatDescriptorCS.Enter;
3748   try
3749     result := FormatDescriptors[aFormat];
3750     if not Assigned(result) then begin
3751       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3752       FormatDescriptors[aFormat] := result;
3753     end;
3754   finally
3755     FormatDescriptorCS.Leave;
3756   end;
3757 end;
3758
3759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3760 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3761 begin
3762   result := Get(Get(aFormat).WithAlpha);
3763 end;
3764
3765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3766 class procedure TFormatDescriptor.Clear;
3767 var
3768   f: TglBitmapFormat;
3769 begin
3770   FormatDescriptorCS.Enter;
3771   try
3772     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3773       FreeAndNil(FormatDescriptors[f]);
3774   finally
3775     FormatDescriptorCS.Leave;
3776   end;
3777 end;
3778
3779 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3780 class procedure TFormatDescriptor.Finalize;
3781 begin
3782   Clear;
3783   FreeAndNil(FormatDescriptorCS);
3784 end;
3785
3786 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3787 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3789 procedure TbmpBitfieldFormat.SetRedMask(const aValue: UInt64);
3790 begin
3791   Update(aValue, fRange.r, fShift.r);
3792 end;
3793
3794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3795 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: UInt64);
3796 begin
3797   Update(aValue, fRange.g, fShift.g);
3798 end;
3799
3800 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3801 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: UInt64);
3802 begin
3803   Update(aValue, fRange.b, fShift.b);
3804 end;
3805
3806 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3807 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: UInt64);
3808 begin
3809   Update(aValue, fRange.a, fShift.a);
3810 end;
3811
3812 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3813 procedure TbmpBitfieldFormat.Update(aMask: UInt64; out aRange: Cardinal; out
3814   aShift: Byte);
3815 begin
3816   aShift := 0;
3817   aRange := 0;
3818   if (aMask = 0) then
3819     exit;
3820   while (aMask > 0) and ((aMask and 1) = 0) do begin
3821     inc(aShift);
3822     aMask := aMask shr 1;
3823   end;
3824   aRange := 1;
3825   while (aMask > 0) do begin
3826     aRange := aRange shl 1;
3827     aMask  := aMask  shr 1;
3828   end;
3829   dec(aRange);
3830
3831   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3832 end;
3833
3834 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3835 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3836 var
3837   data: UInt64;
3838   s: Integer;
3839 type
3840   PUInt64 = ^UInt64;
3841 begin
3842   data :=
3843     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3844     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3845     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3846     ((aPixel.Data.a and fRange.a) shl fShift.a);
3847   s := Round(fPixelSize);
3848   case s of
3849     1:           aData^  := data;
3850     2:     PWord(aData)^ := data;
3851     4: PCardinal(aData)^ := data;
3852     8:   PUInt64(aData)^ := data;
3853   else
3854     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3855   end;
3856   inc(aData, s);
3857 end;
3858
3859 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3860 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
3861 var
3862   data: UInt64;
3863   s, i: Integer;
3864 type
3865   PUInt64 = ^UInt64;
3866 begin
3867   s := Round(fPixelSize);
3868   case s of
3869     1: data :=           aData^;
3870     2: data :=     PWord(aData)^;
3871     4: data := PCardinal(aData)^;
3872     8: data :=   PUInt64(aData)^;
3873   else
3874     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3875   end;
3876   for i := 0 to 3 do
3877     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3878   inc(aData, s);
3879 end;
3880
3881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3882 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3884 procedure TbmpColorTableFormat.CreateColorTable;
3885 var
3886   bits: Byte;
3887   len: Integer;
3888   i: Integer;
3889 begin
3890   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3891     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3892
3893   if (Format = tfLuminance4) then
3894     SetLength(fColorTable, 16)
3895   else
3896     SetLength(fColorTable, 256);
3897
3898   case Format of
3899     tfLuminance4: begin
3900       for i := 0 to High(fColorTable) do begin
3901         fColorTable[i].r := 16 * i;
3902         fColorTable[i].g := 16 * i;
3903         fColorTable[i].b := 16 * i;
3904         fColorTable[i].a := 0;
3905       end;
3906     end;
3907
3908     tfLuminance8: begin
3909       for i := 0 to High(fColorTable) do begin
3910         fColorTable[i].r := i;
3911         fColorTable[i].g := i;
3912         fColorTable[i].b := i;
3913         fColorTable[i].a := 0;
3914       end;
3915     end;
3916
3917     tfR3G3B2: begin
3918       for i := 0 to High(fColorTable) do begin
3919         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3920         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3921         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3922         fColorTable[i].a := 0;
3923       end;
3924     end;
3925   end;
3926 end;
3927
3928 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3929 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3930 var
3931   d: Byte;
3932 begin
3933   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3934     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3935
3936   case Format of
3937     tfLuminance4: begin
3938       if (aMapData = nil) then
3939         aData^ := 0;
3940       d := LuminanceWeight(aPixel) and Range.r;
3941       aData^ := aData^ or (d shl (4 - PtrInt(aMapData)));
3942       inc(aMapData, 4);
3943       if (PtrInt(aMapData) >= 8) then begin
3944         inc(aData);
3945         aMapData := nil;
3946       end;
3947     end;
3948
3949     tfLuminance8: begin
3950       aData^ := LuminanceWeight(aPixel) and Range.r;
3951       inc(aData);
3952     end;
3953
3954     tfR3G3B2: begin
3955       aData^ := Round(
3956         ((aPixel.Data.r and Range.r) shl Shift.r) or
3957         ((aPixel.Data.g and Range.g) shl Shift.g) or
3958         ((aPixel.Data.b and Range.b) shl Shift.b));
3959       inc(aData);
3960     end;
3961   end;
3962 end;
3963
3964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3965 procedure TbmpColorTableFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
3966 type
3967   PUInt64 = ^UInt64;
3968 var
3969   idx: UInt64;
3970   s: Integer;
3971   bits: Byte;
3972   f: Single;
3973 begin
3974   s    := Trunc(fPixelSize);
3975   f    := fPixelSize - s;
3976   bits := Round(8 * f);
3977   case s of
3978     0: idx :=          (aData^ shr (8 - bits - PtrInt(aMapData))) and ((1 shl bits) - 1);
3979     1: idx :=           aData^;
3980     2: idx :=     PWord(aData)^;
3981     4: idx := PCardinal(aData)^;
3982     8: idx :=   PUInt64(aData)^;
3983   else
3984     raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3985   end;
3986   if (idx >= Length(fColorTable)) then
3987     raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
3988   with fColorTable[idx] do begin
3989     aPixel.Data.r := r;
3990     aPixel.Data.g := g;
3991     aPixel.Data.b := b;
3992     aPixel.Data.a := a;
3993   end;
3994   inc(aMapData, bits);
3995   if (PtrInt(aMapData) >= 8) then begin
3996     inc(aData, 1);
3997     dec(aMapData, 8);
3998   end;
3999   inc(aData, s);
4000 end;
4001
4002 destructor TbmpColorTableFormat.Destroy;
4003 begin
4004   SetLength(fColorTable, 0);
4005   inherited Destroy;
4006 end;
4007
4008 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4009 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4010 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4011 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4012 var
4013   i: Integer;
4014 begin
4015   for i := 0 to 3 do begin
4016     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4017       if (aSourceFD.Range.arr[i] > 0) then
4018         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4019       else
4020         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
4021     end;
4022   end;
4023 end;
4024
4025 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4026 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4027 begin
4028   with aFuncRec do begin
4029     if (Source.Range.r   > 0) then
4030       Dest.Data.r := Source.Data.r;
4031     if (Source.Range.g > 0) then
4032       Dest.Data.g := Source.Data.g;
4033     if (Source.Range.b  > 0) then
4034       Dest.Data.b := Source.Data.b;
4035     if (Source.Range.a > 0) then
4036       Dest.Data.a := Source.Data.a;
4037   end;
4038 end;
4039
4040 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4041 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4042 var
4043   i: Integer;
4044 begin
4045   with aFuncRec do begin
4046     for i := 0 to 3 do
4047       if (Source.Range.arr[i] > 0) then
4048         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4049   end;
4050 end;
4051
4052 type
4053   TShiftData = packed record
4054     case Integer of
4055       0: (r, g, b, a: SmallInt);
4056       1: (arr: array[0..3] of SmallInt);
4057   end;
4058   PShiftData = ^TShiftData;
4059
4060 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4061 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4062 var
4063   i: Integer;
4064 begin
4065   with aFuncRec do
4066     for i := 0 to 3 do
4067       if (Source.Range.arr[i] > 0) then
4068         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4069 end;
4070
4071 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4072 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4073 begin
4074   with aFuncRec do begin
4075     Dest.Data := Source.Data;
4076     if (Args and $1 > 0) then begin
4077       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4078       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4079       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4080     end;
4081     if (Args and $2 > 0) then begin
4082       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4083     end;
4084   end;
4085 end;
4086
4087 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4088 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4089 var
4090   i: Integer;
4091 begin
4092   with aFuncRec do begin
4093     for i := 0 to 3 do
4094       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4095   end;
4096 end;
4097
4098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4099 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4100 var
4101   Temp: Single;
4102 begin
4103   with FuncRec do begin
4104     if (FuncRec.Args = 0) then begin //source has no alpha
4105       Temp :=
4106         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4107         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4108         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4109       Dest.Data.a := Round(Dest.Range.a * Temp);
4110     end else
4111       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4112   end;
4113 end;
4114
4115 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4116 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4117 type
4118   PglBitmapPixelData = ^TglBitmapPixelData;
4119 begin
4120   with FuncRec do begin
4121     Dest.Data.r := Source.Data.r;
4122     Dest.Data.g := Source.Data.g;
4123     Dest.Data.b := Source.Data.b;
4124
4125     with PglBitmapPixelData(Args)^ do
4126       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4127           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4128           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4129         Dest.Data.a := 0
4130       else
4131         Dest.Data.a := Dest.Range.a;
4132   end;
4133 end;
4134
4135 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4136 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4137 type
4138   PglBitmapPixelData = ^TglBitmapPixelData;
4139 begin
4140   with FuncRec do begin
4141     Dest.Data.r := Source.Data.r;
4142     Dest.Data.g := Source.Data.g;
4143     Dest.Data.b := Source.Data.b;
4144     Dest.Data.a := PCardinal(Args)^;
4145   end;
4146 end;
4147
4148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4149 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4150 type
4151   PRGBPix = ^TRGBPix;
4152   TRGBPix = array [0..2] of byte;
4153 var
4154   Temp: Byte;
4155 begin
4156   while aWidth > 0 do begin
4157     Temp := PRGBPix(aData)^[0];
4158     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4159     PRGBPix(aData)^[2] := Temp;
4160
4161     if aHasAlpha then
4162       Inc(aData, 4)
4163     else
4164       Inc(aData, 3);
4165     dec(aWidth);
4166   end;
4167 end;
4168
4169 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4170 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4172 function TglBitmap.GetWidth: Integer;
4173 begin
4174   if (ffX in fDimension.Fields) then
4175     result := fDimension.X
4176   else
4177     result := -1;
4178 end;
4179
4180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4181 function TglBitmap.GetHeight: Integer;
4182 begin
4183   if (ffY in fDimension.Fields) then
4184     result := fDimension.Y
4185   else
4186     result := -1;
4187 end;
4188
4189 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4190 function TglBitmap.GetFileWidth: Integer;
4191 begin
4192   result := Max(1, Width);
4193 end;
4194
4195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4196 function TglBitmap.GetFileHeight: Integer;
4197 begin
4198   result := Max(1, Height);
4199 end;
4200
4201 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4202 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4203 begin
4204   if fCustomData = aValue then
4205     exit;
4206   fCustomData := aValue;
4207 end;
4208
4209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4210 procedure TglBitmap.SetCustomName(const aValue: String);
4211 begin
4212   if fCustomName = aValue then
4213     exit;
4214   fCustomName := aValue;
4215 end;
4216
4217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4218 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4219 begin
4220   if fCustomNameW = aValue then
4221     exit;
4222   fCustomNameW := aValue;
4223 end;
4224
4225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4226 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4227 begin
4228   if fDeleteTextureOnFree = aValue then
4229     exit;
4230   fDeleteTextureOnFree := aValue;
4231 end;
4232
4233 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4234 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4235 begin
4236   if fFormat = aValue then
4237     exit;
4238   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4239     raise EglBitmapUnsupportedFormatFormat.Create('SetInternalFormat - ' + UNSUPPORTED_FORMAT);
4240   SetDataPointer(Data, aValue, Width, Height);
4241 end;
4242
4243 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4244 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4245 begin
4246   if fFreeDataAfterGenTexture = aValue then
4247     exit;
4248   fFreeDataAfterGenTexture := aValue;
4249 end;
4250
4251 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4252 procedure TglBitmap.SetID(const aValue: Cardinal);
4253 begin
4254   if fID = aValue then
4255     exit;
4256   fID := aValue;
4257 end;
4258
4259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4260 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4261 begin
4262   if fMipMap = aValue then
4263     exit;
4264   fMipMap := aValue;
4265 end;
4266
4267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4268 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4269 begin
4270   if fTarget = aValue then
4271     exit;
4272   fTarget := aValue;
4273 end;
4274
4275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4276 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4277 var
4278   MaxAnisotropic: Integer;
4279 begin
4280   fAnisotropic := aValue;
4281   if (ID > 0) then begin
4282     if GL_EXT_texture_filter_anisotropic then begin
4283       if fAnisotropic > 0 then begin
4284         Bind(false);
4285         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4286         if aValue > MaxAnisotropic then
4287           fAnisotropic := MaxAnisotropic;
4288         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4289       end;
4290     end else begin
4291       fAnisotropic := 0;
4292     end;
4293   end;
4294 end;
4295
4296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4297 procedure TglBitmap.CreateID;
4298 begin
4299   if (ID <> 0) then
4300     glDeleteTextures(1, @fID);
4301   glGenTextures(1, @fID);
4302   Bind(false);
4303 end;
4304
4305 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4306 procedure TglBitmap.SetupParameters(var aBuildWithGlu: Boolean);
4307 begin
4308   // Set Up Parameters
4309   SetWrap(fWrapS, fWrapT, fWrapR);
4310   SetFilter(fFilterMin, fFilterMag);
4311   SetAnisotropic(fAnisotropic);
4312   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4313
4314   // Mip Maps Generation Mode
4315   aBuildWithGlu := false;
4316   if (MipMap = mmMipmap) then begin
4317     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4318       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4319     else
4320       aBuildWithGlu := true;
4321   end else if (MipMap = mmMipmapGlu) then
4322     aBuildWithGlu := true;
4323 end;
4324
4325 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4326 procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
4327   const aWidth: Integer; const aHeight: Integer);
4328 var
4329   s: Single;
4330 begin
4331   if (Data <> aData) then begin
4332     if (Assigned(Data)) then
4333       FreeMem(Data);
4334     fData := aData;
4335   end;
4336
4337   FillChar(fDimension, SizeOf(fDimension), 0);
4338   if not Assigned(fData) then begin
4339     fFormat    := tfEmpty;
4340     fPixelSize := 0;
4341     fRowSize   := 0;
4342   end else begin
4343     if aWidth <> -1 then begin
4344       fDimension.Fields := fDimension.Fields + [ffX];
4345       fDimension.X := aWidth;
4346     end;
4347
4348     if aHeight <> -1 then begin
4349       fDimension.Fields := fDimension.Fields + [ffY];
4350       fDimension.Y := aHeight;
4351     end;
4352
4353     s := TFormatDescriptor.Get(aFormat).PixelSize;
4354     fFormat    := aFormat;
4355     fPixelSize := Ceil(s);
4356     fRowSize   := Ceil(s * aWidth);
4357   end;
4358 end;
4359
4360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4361 function TglBitmap.FlipHorz: Boolean;
4362 begin
4363   result := false;
4364 end;
4365
4366 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4367 function TglBitmap.FlipVert: Boolean;
4368 begin
4369   result := false;
4370 end;
4371
4372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4373 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4374 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4375 procedure TglBitmap.AfterConstruction;
4376 begin
4377   inherited AfterConstruction;
4378
4379   fID         := 0;
4380   fTarget     := 0;
4381   fIsResident := false;
4382
4383   fFormat                  := glBitmapGetDefaultFormat;
4384   fMipMap                  := glBitmapDefaultMipmap;
4385   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4386   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4387
4388   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4389   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4390 end;
4391
4392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4393 procedure TglBitmap.BeforeDestruction;
4394 begin
4395   SetDataPointer(nil, tfEmpty);
4396   if (fID > 0) and fDeleteTextureOnFree then
4397     glDeleteTextures(1, @fID);
4398   inherited BeforeDestruction;
4399 end;
4400
4401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4402 procedure TglBitmap.LoadFromFile(const aFilename: String);
4403 var
4404   fs: TFileStream;
4405 begin
4406   if not FileExists(aFilename) then
4407     raise EglBitmapException.Create('file does not exist: ' + aFilename);
4408   fFilename := aFilename;
4409   fs := TFileStream.Create(fFilename, fmOpenRead);
4410   try
4411     fs.Position := 0;
4412     LoadFromStream(fs);
4413   finally
4414     fs.Free;
4415   end;
4416 end;
4417
4418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4419 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4420 begin
4421   {$IFDEF GLB_SUPPORT_PNG_READ}
4422   if not LoadPNG(aStream) then
4423   {$ENDIF}
4424   {$IFDEF GLB_SUPPORT_JPEG_READ}
4425   if not LoadJPEG(aStream) then
4426   {$ENDIF}
4427   if not LoadDDS(aStream) then
4428   if not LoadTGA(aStream) then
4429   if not LoadBMP(aStream) then
4430     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4431 end;
4432
4433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4434 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4435   const aFormat: TglBitmapFormat; const aArgs: PtrInt);
4436 var
4437   tmpData: PByte;
4438   size: Integer;
4439 begin
4440   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4441   GetMem(tmpData, size);
4442   try
4443     FillChar(tmpData^, size, #$FF);
4444     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
4445   except
4446     FreeMem(tmpData);
4447     raise;
4448   end;
4449   AddFunc(Self, aFunc, false, Format, aArgs);
4450 end;
4451
4452 {$IFDEF GLB_DELPHI}
4453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4454 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
4455 var
4456   rs: TResourceStream;
4457   TempPos: Integer;
4458   ResTypeStr: String;
4459   TempResType: PChar;
4460 begin
4461   if not Assigned(ResType) then begin
4462     TempPos     := Pos('.', Resource);
4463     ResTypeStr  := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4464     Resource    := UpperCase(Copy(Resource, 0, TempPos -1));
4465     TempResType := PChar(ResTypeStr);
4466   end else
4467     TempResType := ResType
4468
4469   rs := TResourceStream.Create(Instance, Resource, TempResType);
4470   try
4471     LoadFromStream(rs);
4472   finally
4473     rs.Free;
4474   end;
4475 end;
4476
4477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4478 procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4479 var
4480   rs: TResourceStream;
4481 begin
4482   rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4483   try
4484     LoadFromStream(rs);
4485   finally
4486     rs.Free;
4487   end;
4488 end;
4489 {$ENDIF}
4490
4491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4492 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4493 var
4494   fs: TFileStream;
4495 begin
4496   fs := TFileStream.Create(aFileName, fmCreate);
4497   try
4498     fs.Position := 0;
4499     SaveToStream(fs, aFileType);
4500   finally
4501     fs.Free;
4502   end;
4503 end;
4504
4505 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4506 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4507 begin
4508   case aFileType of
4509     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4510     ftPNG:  SavePng(aStream);
4511     {$ENDIF}
4512     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4513     ftJPEG: SaveJPEG(aStream);
4514     {$ENDIF}
4515     ftDDS:  SaveDDS(aStream);
4516     ftTGA:  SaveTGA(aStream);
4517     ftBMP:  SaveBMP(aStream);
4518   end;
4519 end;
4520
4521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4522 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt): Boolean;
4523 begin
4524   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4525 end;
4526
4527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4528 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4529   const aFormat: TglBitmapFormat; const aArgs: PtrInt): Boolean;
4530 var
4531   DestData, TmpData, SourceData: pByte;
4532   TempHeight, TempWidth: Integer;
4533   SourceFD, DestFD: TFormatDescriptor;
4534   SourceMD, DestMD: Pointer;
4535
4536   FuncRec: TglBitmapFunctionRec;
4537 begin
4538   Assert(Assigned(Data));
4539   Assert(Assigned(aSource));
4540   Assert(Assigned(aSource.Data));
4541
4542   result := false;
4543   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4544     SourceFD := TFormatDescriptor.Get(aSource.Format);
4545     DestFD   := TFormatDescriptor.Get(aFormat);
4546
4547     // inkompatible Formats so CreateTemp
4548     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4549       aCreateTemp := true;
4550
4551     // Values
4552     TempHeight := Max(1, aSource.Height);
4553     TempWidth  := Max(1, aSource.Width);
4554
4555     FuncRec.Sender := Self;
4556     FuncRec.Args   := aArgs;
4557
4558     TmpData := nil;
4559     if aCreateTemp then begin
4560       GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
4561       DestData := TmpData;
4562     end else
4563       DestData := Data;
4564
4565     try
4566       SourceFD.PreparePixel(FuncRec.Source);
4567       DestFD.PreparePixel  (FuncRec.Dest);
4568
4569       SourceMD := SourceFD.CreateMappingData;
4570       DestMD   := DestFD.CreateMappingData;
4571
4572       FuncRec.Size            := aSource.Dimension;
4573       FuncRec.Position.Fields := FuncRec.Size.Fields;
4574
4575       try
4576         SourceData := aSource.Data;
4577         FuncRec.Position.Y := 0;
4578         while FuncRec.Position.Y < TempHeight do begin
4579           FuncRec.Position.X := 0;
4580           while FuncRec.Position.X < TempWidth do begin
4581             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4582             aFunc(FuncRec);
4583             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4584             inc(FuncRec.Position.X);
4585           end;
4586           inc(FuncRec.Position.Y);
4587         end;
4588
4589         // Updating Image or InternalFormat
4590         if aCreateTemp then
4591           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
4592         else if (aFormat <> fFormat) then
4593           Format := aFormat;
4594
4595         result := true;
4596       finally
4597         SourceFD.FreeMappingData(SourceMD);
4598         DestFD.FreeMappingData(DestMD);
4599       end;
4600     except
4601       if aCreateTemp then
4602         FreeMem(TmpData);
4603       raise;
4604     end;
4605   end;
4606 end;
4607
4608 {$IFDEF GLB_SDL}
4609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4610 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4611 var
4612   Row, RowSize: Integer;
4613   SourceData, TmpData: PByte;
4614   TempDepth: Integer;
4615   Pix: TglBitmapPixelData;
4616   FormatDesc: TglBitmapFormatDescriptor;
4617
4618   function GetRowPointer(Row: Integer): pByte;
4619   begin
4620     result := Surface.pixels;
4621     Inc(result, Row * RowSize);
4622   end;
4623
4624 begin
4625   result := false;
4626
4627   (* TODO
4628   if not FormatIsUncompressed(InternalFormat) then
4629     raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
4630   *)
4631
4632   FormatDesc := FORMAT_DESCRIPTORS[Format];
4633   if Assigned(Data) then begin
4634     case Trunc(FormatDesc.GetSize) of
4635       1: TempDepth :=  8;
4636       2: TempDepth := 16;
4637       3: TempDepth := 24;
4638       4: TempDepth := 32;
4639     else
4640       raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
4641     end;
4642     FormatDesc.PreparePixel(Pix);
4643     with Pix.PixelDesc do
4644       Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4645         RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);
4646
4647     SourceData := Data;
4648     RowSize    := Ceil(FileWidth * FormatDesc.GetSize);
4649
4650     for Row := 0 to FileHeight -1 do begin
4651       TmpData := GetRowPointer(Row);
4652       if Assigned(TmpData) then begin
4653         Move(SourceData^, TmpData^, RowSize);
4654         inc(SourceData, RowSize);
4655       end;
4656     end;
4657     result := true;
4658   end;
4659 end;
4660
4661 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4662 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4663 var
4664   pSource, pData, pTempData: PByte;
4665   Row, RowSize, TempWidth, TempHeight: Integer;
4666   IntFormat, f: TglBitmapInternalFormat;
4667   FormatDesc: TglBitmapFormatDescriptor;
4668
4669   function GetRowPointer(Row: Integer): pByte;
4670   begin
4671     result := Surface^.pixels;
4672     Inc(result, Row * RowSize);
4673   end;
4674
4675 begin
4676   result := false;
4677   if (Assigned(Surface)) then begin
4678     with Surface^.format^ do begin
4679       IntFormat := tfEmpty;
4680       for f := Low(f) to High(f) do begin
4681         if FORMAT_DESCRIPTORS[f].MaskMatch(RMask, GMask, BMask, AMask) then begin
4682           IntFormat := f;
4683           break;
4684         end;
4685       end;
4686       if (IntFormat = tfEmpty) then
4687         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4688     end;
4689
4690     FormatDesc := FORMAT_DESCRIPTORS[IntFormat];
4691     TempWidth  := Surface^.w;
4692     TempHeight := Surface^.h;
4693     RowSize := Trunc(TempWidth * FormatDesc.GetSize);
4694     GetMem(pData, TempHeight * RowSize);
4695     try
4696       pTempData := pData;
4697       for Row := 0 to TempHeight -1 do begin
4698         pSource := GetRowPointer(Row);
4699         if (Assigned(pSource)) then begin
4700           Move(pSource^, pTempData^, RowSize);
4701           Inc(pTempData, RowSize);
4702         end;
4703       end;
4704       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4705       result := true;
4706     except
4707       FreeMem(pData);
4708       raise;
4709     end;
4710   end;
4711 end;
4712
4713 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4714 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4715 var
4716   Row, Col, AlphaInterleave: Integer;
4717   pSource, pDest: PByte;
4718
4719   function GetRowPointer(Row: Integer): pByte;
4720   begin
4721     result := aSurface.pixels;
4722     Inc(result, Row * Width);
4723   end;
4724
4725 begin
4726   result := false;
4727   if Assigned(Data) then begin
4728     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4729       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4730
4731       AlphaInterleave := 0;
4732       case Format of
4733         ifLuminance8Alpha8:
4734           AlphaInterleave := 1;
4735         ifBGRA8, ifRGBA8:
4736           AlphaInterleave := 3;
4737       end;
4738
4739       pSource := Data;
4740       for Row := 0 to Height -1 do begin
4741         pDest := GetRowPointer(Row);
4742         if Assigned(pDest) then begin
4743           for Col := 0 to Width -1 do begin
4744             Inc(pSource, AlphaInterleave);
4745             pDest^ := pSource^;
4746             Inc(pDest);
4747             Inc(pSource);
4748           end;
4749         end;
4750       end;
4751       result := true;
4752     end;
4753   end;
4754 end;
4755
4756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4757 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4758 var
4759   bmp: TglBitmap2D;
4760 begin
4761   bmp := TglBitmap2D.Create;
4762   try
4763     bmp.AssignFromSurface(Surface);
4764     result := AddAlphaFromGlBitmap(bmp, Func, CustomData);
4765   finally
4766     bmp.Free;
4767   end;
4768 end;
4769 {$ENDIF}
4770
4771 {$IFDEF GLB_DELPHI}
4772 //TODO rework & test
4773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4774 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4775 var
4776   Row: Integer;
4777   pSource, pData: PByte;
4778 begin
4779   result := false;
4780   if Assigned(Data) then begin
4781     if Assigned(aBitmap) then begin
4782       aBitmap.Width  := Width;
4783       aBitmap.Height := Height;
4784
4785       case Format of
4786         tfAlpha8, ifLuminance, ifDepth8:
4787           begin
4788             Bitmap.PixelFormat := pf8bit;
4789             Bitmap.Palette := CreateGrayPalette;
4790           end;
4791         ifRGB5A1:
4792           Bitmap.PixelFormat := pf15bit;
4793         ifR5G6B5:
4794           Bitmap.PixelFormat := pf16bit;
4795         ifRGB8, ifBGR8:
4796           Bitmap.PixelFormat := pf24bit;
4797         ifRGBA8, ifBGRA8:
4798           Bitmap.PixelFormat := pf32bit;
4799         else
4800           raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4801       end;
4802
4803       pSource := Data;
4804       for Row := 0 to FileHeight -1 do begin
4805         pData := Bitmap.Scanline[Row];
4806
4807         Move(pSource^, pData^, fRowSize);
4808         Inc(pSource, fRowSize);
4809
4810         // swap RGB(A) to BGR(A)
4811         if InternalFormat in [ifRGB8, ifRGBA8] then
4812           SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
4813       end;
4814
4815       result := true;
4816     end;
4817   end;
4818 end;
4819
4820 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4821 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4822 var
4823   pSource, pData, pTempData: PByte;
4824   Row, RowSize, TempWidth, TempHeight: Integer;
4825   IntFormat: TglBitmapInternalFormat;
4826 begin
4827   result := false;
4828
4829   if (Assigned(Bitmap)) then begin
4830     case Bitmap.PixelFormat of
4831       pf8bit:
4832         IntFormat := ifLuminance;
4833       pf15bit:
4834         IntFormat := ifRGB5A1;
4835       pf16bit:
4836         IntFormat := ifR5G6B5;
4837       pf24bit:
4838         IntFormat := ifBGR8;
4839       pf32bit:
4840         IntFormat := ifBGRA8;
4841       else
4842         raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4843     end;
4844
4845     TempWidth := Bitmap.Width;
4846     TempHeight := Bitmap.Height;
4847
4848     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
4849
4850     GetMem(pData, TempHeight * RowSize);
4851     try
4852       pTempData := pData;
4853
4854       for Row := 0 to TempHeight -1 do begin
4855         pSource := Bitmap.Scanline[Row];
4856
4857         if (Assigned(pSource)) then begin
4858           Move(pSource^, pTempData^, RowSize);
4859           Inc(pTempData, RowSize);
4860         end;
4861       end;
4862
4863       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4864
4865       result := true;
4866     except
4867       FreeMem(pData);
4868       raise;
4869     end;
4870   end;
4871 end;
4872
4873 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4874 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4875 var
4876   Row, Col, AlphaInterleave: Integer;
4877   pSource, pDest: PByte;
4878 begin
4879   result := false;
4880
4881   if Assigned(Data) then begin
4882     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
4883       if Assigned(Bitmap) then begin
4884         Bitmap.PixelFormat := pf8bit;
4885         Bitmap.Palette := CreateGrayPalette;
4886         Bitmap.Width := Width;
4887         Bitmap.Height := Height;
4888
4889         case InternalFormat of
4890           ifLuminanceAlpha:
4891             AlphaInterleave := 1;
4892           ifRGBA8, ifBGRA8:
4893             AlphaInterleave := 3;
4894           else
4895             AlphaInterleave := 0;
4896         end;
4897
4898         // Copy Data
4899         pSource := Data;
4900
4901         for Row := 0 to Height -1 do begin
4902           pDest := Bitmap.Scanline[Row];
4903
4904           if Assigned(pDest) then begin
4905             for Col := 0 to Width -1 do begin
4906               Inc(pSource, AlphaInterleave);
4907               pDest^ := pSource^;
4908               Inc(pDest);
4909               Inc(pSource);
4910             end;
4911           end;
4912         end;
4913
4914         result := true;
4915       end;
4916     end;
4917   end;
4918 end;
4919
4920 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4921 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4922 var
4923   tex: TglBitmap2D;
4924 begin
4925   tex := TglBitmap2D.Create;
4926   try
4927     tex.AssignFromBitmap(Bitmap);
4928     result := AddAlphaFromglBitmap(tex, Func, CustomData);
4929   finally
4930     tex.Free;
4931   end;
4932 end;
4933
4934 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4935 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
4936   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4937 var
4938   RS: TResourceStream;
4939   TempPos: Integer;
4940   ResTypeStr: String;
4941   TempResType: PChar;
4942 begin
4943   if Assigned(ResType) then
4944     TempResType := ResType
4945   else
4946     begin
4947       TempPos := Pos('.', Resource);
4948       ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4949       Resource   := UpperCase(Copy(Resource, 0, TempPos -1));
4950       TempResType := PChar(ResTypeStr);
4951     end;
4952
4953   RS := TResourceStream.Create(Instance, Resource, TempResType);
4954   try
4955     result := AddAlphaFromStream(RS, Func, CustomData);
4956   finally
4957     RS.Free;
4958   end;
4959 end;
4960
4961 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4962 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
4963   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4964 var
4965   RS: TResourceStream;
4966 begin
4967   RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4968   try
4969     result := AddAlphaFromStream(RS, Func, CustomData);
4970   finally
4971     RS.Free;
4972   end;
4973 end;
4974 {$ENDIF}
4975
4976 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4977 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4978 begin
4979   (* TODO
4980   if not FormatIsUncompressed(InternalFormat) then
4981     raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT);
4982   *)
4983   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
4984 end;
4985
4986 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4987 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4988 var
4989   FS: TFileStream;
4990 begin
4991   FS := TFileStream.Create(FileName, fmOpenRead);
4992   try
4993     result := AddAlphaFromStream(FS, aFunc, aArgs);
4994   finally
4995     FS.Free;
4996   end;
4997 end;
4998
4999 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5000 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
5001 var
5002   tex: TglBitmap2D;
5003 begin
5004   tex := TglBitmap2D.Create(aStream);
5005   try
5006     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5007   finally
5008     tex.Free;
5009   end;
5010 end;
5011
5012 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5013 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
5014 var
5015   DestData, DestData2, SourceData: pByte;
5016   TempHeight, TempWidth: Integer;
5017   SourceFD, DestFD: TFormatDescriptor;
5018   SourceMD, DestMD, DestMD2: Pointer;
5019
5020   FuncRec: TglBitmapFunctionRec;
5021 begin
5022   result := false;
5023
5024   Assert(Assigned(Data));
5025   Assert(Assigned(aBitmap));
5026   Assert(Assigned(aBitmap.Data));
5027
5028   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5029     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5030     if not Assigned(aFunc) then
5031       aFunc := glBitmapAlphaFunc;
5032
5033     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5034     DestFD   := TFormatDescriptor.Get(Format);
5035
5036     // Values
5037     TempHeight := aBitmap.FileHeight;
5038     TempWidth  := aBitmap.FileWidth;
5039
5040     FuncRec.Sender          := Self;
5041     FuncRec.Args            := aArgs;
5042     FuncRec.Size            := Dimension;
5043     FuncRec.Position.Fields := FuncRec.Size.Fields;
5044     FuncRec.Args            := PtrInt(SourceFD.HasAlpha) and 1;
5045
5046     DestData   := Data;
5047     DestData2  := Data;
5048     SourceData := aBitmap.Data;
5049
5050     // Mapping
5051     SourceFD.PreparePixel(FuncRec.Source);
5052     DestFD.PreparePixel  (FuncRec.Dest);
5053
5054     SourceMD := SourceFD.CreateMappingData;
5055     DestMD   := DestFD.CreateMappingData;
5056     DestMD2  := DestFD.CreateMappingData;
5057     try
5058       FuncRec.Position.Y := 0;
5059       while FuncRec.Position.Y < TempHeight do begin
5060         FuncRec.Position.X := 0;
5061         while FuncRec.Position.X < TempWidth do begin
5062           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5063           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5064           aFunc(FuncRec);
5065           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5066           inc(FuncRec.Position.X);
5067         end;
5068         inc(FuncRec.Position.Y);
5069       end;
5070     finally
5071       SourceFD.FreeMappingData(SourceMD);
5072       DestFD.FreeMappingData(DestMD);
5073       DestFD.FreeMappingData(DestMD2);
5074     end;
5075   end;
5076 end;
5077
5078 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5079 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5080 begin
5081   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5082 end;
5083
5084 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5085 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5086 var
5087   PixelData: TglBitmapPixelData;
5088 begin
5089   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5090   result := AddAlphaFromColorKeyFloat(
5091     aRed   / PixelData.Range.r,
5092     aGreen / PixelData.Range.g,
5093     aBlue  / PixelData.Range.b,
5094     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5095 end;
5096
5097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5098 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5099 var
5100   values: array[0..2] of Single;
5101   tmp: Cardinal;
5102   i: Integer;
5103   PixelData: TglBitmapPixelData;
5104 begin
5105   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5106   with PixelData do begin
5107     values[0] := aRed;
5108     values[1] := aGreen;
5109     values[2] := aBlue;
5110
5111     for i := 0 to 2 do begin
5112       tmp          := Trunc(Range.arr[i] * aDeviation);
5113       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5114       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5115     end;
5116     Data.a  := 0;
5117     Range.a := 0;
5118   end;
5119   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, PtrInt(@PixelData));
5120 end;
5121
5122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5123 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5124 begin
5125   result := AddAlphaFromValueFloat(aAlpha / $FF);
5126 end;
5127
5128 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5129 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5130 var
5131   PixelData: TglBitmapPixelData;
5132 begin
5133   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5134   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5135 end;
5136
5137 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5138 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5139 var
5140   PixelData: TglBitmapPixelData;
5141 begin
5142   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5143   with PixelData do
5144     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5145   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, PtrInt(@PixelData.Data.a));
5146 end;
5147
5148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5149 function TglBitmap.RemoveAlpha: Boolean;
5150 var
5151   FormatDesc: TFormatDescriptor;
5152 begin
5153   result := false;
5154   FormatDesc := TFormatDescriptor.Get(Format);
5155   if Assigned(Data) then begin
5156     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5157       raise EglBitmapUnsupportedFormatFormat.Create('RemoveAlpha - ' + UNSUPPORTED_FORMAT);
5158     result := ConvertTo(FormatDesc.WithoutAlpha);
5159   end;
5160 end;
5161
5162 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5163 function TglBitmap.Clone: TglBitmap;
5164 var
5165   Temp: TglBitmap;
5166   TempPtr: PByte;
5167   Size: Integer;
5168 begin
5169   result := nil;
5170   Temp := (ClassType.Create as TglBitmap);
5171   try
5172     // copy texture data if assigned
5173     if Assigned(Data) then begin
5174       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5175       GetMem(TempPtr, Size);
5176       try
5177         Move(Data^, TempPtr^, Size);
5178         Temp.SetDataPointer(TempPtr, Format, Width, Height);
5179       except
5180         FreeMem(TempPtr);
5181         raise;
5182       end;
5183     end else
5184       Temp.SetDataPointer(nil, Format, Width, Height);
5185
5186         // copy properties
5187     Temp.fID                      := ID;
5188     Temp.fTarget                  := Target;
5189     Temp.fFormat                  := Format;
5190     Temp.fMipMap                  := MipMap;
5191     Temp.fAnisotropic             := Anisotropic;
5192     Temp.fBorderColor             := fBorderColor;
5193     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5194     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5195     Temp.fFilterMin               := fFilterMin;
5196     Temp.fFilterMag               := fFilterMag;
5197     Temp.fWrapS                   := fWrapS;
5198     Temp.fWrapT                   := fWrapT;
5199     Temp.fWrapR                   := fWrapR;
5200     Temp.fFilename                := fFilename;
5201     Temp.fCustomName              := fCustomName;
5202     Temp.fCustomNameW             := fCustomNameW;
5203     Temp.fCustomData              := fCustomData;
5204
5205     result := Temp;
5206   except
5207     FreeAndNil(Temp);
5208     raise;
5209   end;
5210 end;
5211
5212 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5213 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5214 var
5215   SourceFD, DestFD: TFormatDescriptor;
5216   SourcePD, DestPD: TglBitmapPixelData;
5217   ShiftData: TShiftData;
5218
5219   function CanCopyDirect: Boolean;
5220   begin
5221     result :=
5222       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5223       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5224       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5225       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5226   end;
5227
5228   function CanShift: Boolean;
5229   begin
5230     result :=
5231       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5232       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5233       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5234       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5235   end;
5236
5237   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5238   begin
5239     result := 0;
5240     while (aSource > aDest) and (aSource > 0) do begin
5241       inc(result);
5242       aSource := aSource shr 1;
5243     end;
5244   end;
5245
5246 begin
5247   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5248     SourceFD := TFormatDescriptor.Get(Format);
5249     DestFD   := TFormatDescriptor.Get(aFormat);
5250
5251     SourceFD.PreparePixel(SourcePD);
5252     DestFD.PreparePixel  (DestPD);
5253
5254     if CanCopyDirect then
5255       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5256     else if CanShift then begin
5257       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5258       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5259       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5260       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5261       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, PtrInt(@ShiftData));
5262     end else
5263       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5264   end else
5265     result := true;
5266 end;
5267
5268 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5269 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5270 begin
5271   if aUseRGB or aUseAlpha then
5272     AddFunc(glBitmapInvertFunc, false, ((PtrInt(aUseAlpha) and 1) shl 1) or (PtrInt(aUseRGB) and 1));
5273 end;
5274
5275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5276 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5277 begin
5278   fBorderColor[0] := aRed;
5279   fBorderColor[1] := aGreen;
5280   fBorderColor[2] := aBlue;
5281   fBorderColor[3] := aAlpha;
5282   if (ID > 0) then begin
5283     Bind(false);
5284     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5285   end;
5286 end;
5287
5288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5289 procedure TglBitmap.FreeData;
5290 begin
5291   SetDataPointer(nil, tfEmpty);
5292 end;
5293
5294 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5295 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5296   const aAlpha: Byte);
5297 begin
5298   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5299 end;
5300
5301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5302 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5303 var
5304   PixelData: TglBitmapPixelData;
5305 begin
5306   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5307   FillWithColorFloat(
5308     aRed   / PixelData.Range.r,
5309     aGreen / PixelData.Range.g,
5310     aBlue  / PixelData.Range.b,
5311     aAlpha / PixelData.Range.a);
5312 end;
5313
5314 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5315 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5316 var
5317   PixelData: TglBitmapPixelData;
5318 begin
5319   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5320   with PixelData do begin
5321     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5322     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5323     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5324     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5325   end;
5326   AddFunc(glBitmapFillWithColorFunc, false, PtrInt(@PixelData));
5327 end;
5328
5329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5330 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
5331 begin
5332   //check MIN filter
5333   case aMin of
5334     GL_NEAREST:
5335       fFilterMin := GL_NEAREST;
5336     GL_LINEAR:
5337       fFilterMin := GL_LINEAR;
5338     GL_NEAREST_MIPMAP_NEAREST:
5339       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5340     GL_LINEAR_MIPMAP_NEAREST:
5341       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5342     GL_NEAREST_MIPMAP_LINEAR:
5343       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5344     GL_LINEAR_MIPMAP_LINEAR:
5345       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5346     else
5347       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
5348   end;
5349
5350   //check MAG filter
5351   case aMag of
5352     GL_NEAREST:
5353       fFilterMag := GL_NEAREST;
5354     GL_LINEAR:
5355       fFilterMag := GL_LINEAR;
5356     else
5357       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
5358   end;
5359
5360   //apply filter
5361   if (ID > 0) then begin
5362     Bind(false);
5363     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5364
5365     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5366       case fFilterMin of
5367         GL_NEAREST, GL_LINEAR:
5368           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5369         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5370           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5371         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5372           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5373       end;
5374     end else
5375       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5376   end;
5377 end;
5378
5379 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5380 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
5381
5382   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5383   begin
5384     case aValue of
5385       GL_CLAMP:
5386         aTarget := GL_CLAMP;
5387
5388       GL_REPEAT:
5389         aTarget := GL_REPEAT;
5390
5391       GL_CLAMP_TO_EDGE: begin
5392         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5393           aTarget := GL_CLAMP_TO_EDGE
5394         else
5395           aTarget := GL_CLAMP;
5396       end;
5397
5398       GL_CLAMP_TO_BORDER: begin
5399         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5400           aTarget := GL_CLAMP_TO_BORDER
5401         else
5402           aTarget := GL_CLAMP;
5403       end;
5404
5405       GL_MIRRORED_REPEAT: begin
5406         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5407           aTarget := GL_MIRRORED_REPEAT
5408         else
5409           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5410       end;
5411     else
5412       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
5413     end;
5414   end;
5415
5416 begin
5417   CheckAndSetWrap(S, fWrapS);
5418   CheckAndSetWrap(T, fWrapT);
5419   CheckAndSetWrap(R, fWrapR);
5420
5421   if (ID > 0) then begin
5422     Bind(false);
5423     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5424     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5425     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5426   end;
5427 end;
5428
5429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5430 procedure TglBitmap.GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);
5431 begin
5432   { TODO delete?
5433   if Assigned (fGetPixelFunc) then
5434     fGetPixelFunc(aPos, aPixel);
5435     }
5436 end;
5437
5438 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5439 procedure TglBitmap.SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData);
5440 begin
5441   {TODO delete?
5442   if Assigned (fSetPixelFunc) then
5443     fSetPixelFuc(aPos, aPixel);
5444     }
5445 end;
5446
5447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5448 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5449 begin
5450   if aEnableTextureUnit then
5451     glEnable(Target);
5452   if (ID > 0) then
5453     glBindTexture(Target, ID);
5454 end;
5455
5456 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5457 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5458 begin
5459   if aDisableTextureUnit then
5460     glDisable(Target);
5461   glBindTexture(Target, 0);
5462 end;
5463
5464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5465 constructor TglBitmap.Create;
5466 begin
5467 {$IFDEF GLB_NATIVE_OGL}
5468   glbReadOpenGLExtensions;
5469 {$ENDIF}
5470   if (ClassType = TglBitmap) then
5471     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5472   inherited Create;
5473 end;
5474
5475 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5476 constructor TglBitmap.Create(const aFileName: String);
5477 begin
5478   Create;
5479   LoadFromFile(FileName);
5480 end;
5481
5482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5483 constructor TglBitmap.Create(const aStream: TStream);
5484 begin
5485   Create;
5486   LoadFromStream(aStream);
5487 end;
5488
5489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5490 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5491 var
5492   Image: PByte;
5493   ImageSize: Integer;
5494 begin
5495   Create;
5496   TFormatDescriptor.Get(aFormat).GetSize(aSize);
5497   GetMem(Image, ImageSize);
5498   try
5499     FillChar(Image^, ImageSize, #$FF);
5500     SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
5501   except
5502     FreeMem(Image);
5503     raise;
5504   end;
5505 end;
5506
5507 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5508 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5509   const aFunc: TglBitmapFunction; const aArgs: PtrInt);
5510 begin
5511   Create;
5512   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5513 end;
5514
5515 {$IFDEF GLB_DELPHI}
5516 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5517 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5518 begin
5519   Create;
5520   LoadFromResource(aInstance, aResource, aResType);
5521 end;
5522
5523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5524 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5525 begin
5526   Create;
5527   LoadFromResourceID(aInstance, aResourceID, aResType);
5528 end;
5529 {$ENDIF}
5530
5531 {$IFDEF GLB_SUPPORT_PNG_READ}
5532 {$IF DEFINED(GLB_SDL_IMAGE)}
5533 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5534 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5535 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5536 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5537 var
5538   Surface: PSDL_Surface;
5539   RWops: PSDL_RWops;
5540 begin
5541   result := false;
5542   RWops := glBitmapCreateRWops(aStream);
5543   try
5544     if IMG_isPNG(RWops) > 0 then begin
5545       Surface := IMG_LoadPNG_RW(RWops);
5546       try
5547         AssignFromSurface(Surface);
5548         Rresult := true;
5549       finally
5550         SDL_FreeSurface(Surface);
5551       end;
5552     end;
5553   finally
5554     SDL_FreeRW(RWops);
5555   end;
5556 end;
5557
5558 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5559 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5560 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5561 begin
5562   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5563 end;
5564
5565 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5566 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5567 var
5568   StreamPos: Int64;
5569   signature: array [0..7] of byte;
5570   png: png_structp;
5571   png_info: png_infop;
5572
5573   TempHeight, TempWidth: Integer;
5574   Format: TglBitmapInternalFormat;
5575
5576   png_data: pByte;
5577   png_rows: array of pByte;
5578   Row, LineSize: Integer;
5579 begin
5580   result := false;
5581
5582   if not init_libPNG then
5583     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5584
5585   try
5586     // signature
5587     StreamPos := Stream.Position;
5588     Stream.Read(signature, 8);
5589     Stream.Position := StreamPos;
5590
5591     if png_check_sig(@signature, 8) <> 0 then begin
5592       // png read struct
5593       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5594       if png = nil then
5595         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5596
5597       // png info
5598       png_info := png_create_info_struct(png);
5599       if png_info = nil then begin
5600         png_destroy_read_struct(@png, nil, nil);
5601         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5602       end;
5603
5604       // set read callback
5605       png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
5606
5607       // read informations
5608       png_read_info(png, png_info);
5609
5610       // size
5611       TempHeight := png_get_image_height(png, png_info);
5612       TempWidth := png_get_image_width(png, png_info);
5613
5614       // format
5615       case png_get_color_type(png, png_info) of
5616         PNG_COLOR_TYPE_GRAY:
5617           Format := tfLuminance8;
5618         PNG_COLOR_TYPE_GRAY_ALPHA:
5619           Format := tfLuminance8Alpha8;
5620         PNG_COLOR_TYPE_RGB:
5621           Format := tfRGB8;
5622         PNG_COLOR_TYPE_RGB_ALPHA:
5623           Format := tfRGBA8;
5624         else
5625           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5626       end;
5627
5628       // cut upper 8 bit from 16 bit formats
5629       if png_get_bit_depth(png, png_info) > 8 then
5630         png_set_strip_16(png);
5631
5632       // expand bitdepth smaller than 8
5633       if png_get_bit_depth(png, png_info) < 8 then
5634         png_set_expand(png);
5635
5636       // allocating mem for scanlines
5637       LineSize := png_get_rowbytes(png, png_info);
5638       GetMem(png_data, TempHeight * LineSize);
5639       try
5640         SetLength(png_rows, TempHeight);
5641         for Row := Low(png_rows) to High(png_rows) do begin
5642           png_rows[Row] := png_data;
5643           Inc(png_rows[Row], Row * LineSize);
5644         end;
5645
5646         // read complete image into scanlines
5647         png_read_image(png, @png_rows[0]);
5648
5649         // read end
5650         png_read_end(png, png_info);
5651
5652         // destroy read struct
5653         png_destroy_read_struct(@png, @png_info, nil);
5654
5655         SetLength(png_rows, 0);
5656
5657         // set new data
5658         SetDataPointer(png_data, Format, TempWidth, TempHeight);
5659
5660         result := true;
5661       except
5662         FreeMem(png_data);
5663         raise;
5664       end;
5665     end;
5666   finally
5667     quit_libPNG;
5668   end;
5669 end;
5670
5671 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5672 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5673 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5674 var
5675   StreamPos: Int64;
5676   Png: TPNGObject;
5677   Header: Array[0..7] of Byte;
5678   Row, Col, PixSize, LineSize: Integer;
5679   NewImage, pSource, pDest, pAlpha: pByte;
5680   Format: TglBitmapInternalFormat;
5681
5682 const
5683   PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
5684
5685 begin
5686   result := false;
5687
5688   StreamPos := Stream.Position;
5689   Stream.Read(Header[0], SizeOf(Header));
5690   Stream.Position := StreamPos;
5691
5692   {Test if the header matches}
5693   if Header = PngHeader then begin
5694     Png := TPNGObject.Create;
5695     try
5696       Png.LoadFromStream(Stream);
5697
5698       case Png.Header.ColorType of
5699         COLOR_GRAYSCALE:
5700           Format := ifLuminance;
5701         COLOR_GRAYSCALEALPHA:
5702           Format := ifLuminanceAlpha;
5703         COLOR_RGB:
5704           Format := ifBGR8;
5705         COLOR_RGBALPHA:
5706           Format := ifBGRA8;
5707         else
5708           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5709       end;
5710
5711       PixSize := Trunc(FormatGetSize(Format));
5712       LineSize := Integer(Png.Header.Width) * PixSize;
5713
5714       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5715       try
5716         pDest := NewImage;
5717
5718         case Png.Header.ColorType of
5719           COLOR_RGB, COLOR_GRAYSCALE:
5720             begin
5721               for Row := 0 to Png.Height -1 do begin
5722                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5723                 Inc(pDest, LineSize);
5724               end;
5725             end;
5726           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5727             begin
5728               PixSize := PixSize -1;
5729
5730               for Row := 0 to Png.Height -1 do begin
5731                 pSource := Png.Scanline[Row];
5732                 pAlpha := pByte(Png.AlphaScanline[Row]);
5733
5734                 for Col := 0 to Png.Width -1 do begin
5735                   Move (pSource^, pDest^, PixSize);
5736                   Inc(pSource, PixSize);
5737                   Inc(pDest, PixSize);
5738
5739                   pDest^ := pAlpha^;
5740                   inc(pAlpha);
5741                   Inc(pDest);
5742                 end;
5743               end;
5744             end;
5745           else
5746             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5747         end;
5748
5749         SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
5750
5751         result := true;
5752       except
5753         FreeMem(NewImage);
5754         raise;
5755       end;
5756     finally
5757       Png.Free;
5758     end;
5759   end;
5760 end;
5761 {$IFEND}
5762 {$ENDIF}
5763
5764 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5765 {$IFDEF GLB_LIB_PNG}
5766 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5767 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5768 begin
5769   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5770 end;
5771 {$ENDIF}
5772
5773 {$IF DEFINED(GLB_LIB_PNG)}
5774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5775 procedure TglBitmap.SavePNG(const aStream: TStream);
5776 var
5777   png: png_structp;
5778   png_info: png_infop;
5779   png_rows: array of pByte;
5780   LineSize: Integer;
5781   ColorType: Integer;
5782   Row: Integer;
5783 begin
5784   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
5785     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5786
5787   if not init_libPNG then
5788     raise Exception.Create('SavePNG - unable to initialize libPNG.');
5789
5790   try
5791     case FInternalFormat of
5792       ifAlpha, ifLuminance, ifDepth8:
5793         ColorType := PNG_COLOR_TYPE_GRAY;
5794       ifLuminanceAlpha:
5795         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5796       ifBGR8, ifRGB8:
5797         ColorType := PNG_COLOR_TYPE_RGB;
5798       ifBGRA8, ifRGBA8:
5799         ColorType := PNG_COLOR_TYPE_RGBA;
5800       else
5801         raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5802     end;
5803     LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
5804
5805     // creating array for scanline
5806     SetLength(png_rows, Height);
5807     try
5808       for Row := 0 to Height - 1 do begin
5809         png_rows[Row] := Data;
5810         Inc(png_rows[Row], Row * LineSize)
5811       end;
5812
5813       // write struct
5814       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5815       if png = nil then
5816         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5817
5818       // create png info
5819       png_info := png_create_info_struct(png);
5820       if png_info = nil then begin
5821         png_destroy_write_struct(@png, nil);
5822         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5823       end;
5824
5825       // set read callback
5826       png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
5827
5828       // set compression
5829       png_set_compression_level(png, 6);
5830
5831       if InternalFormat in [ifBGR8, ifBGRA8] then
5832         png_set_bgr(png);
5833
5834       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5835       png_write_info(png, png_info);
5836       png_write_image(png, @png_rows[0]);
5837       png_write_end(png, png_info);
5838       png_destroy_write_struct(@png, @png_info);
5839     finally
5840       SetLength(png_rows, 0);
5841     end;
5842   finally
5843     quit_libPNG;
5844   end;
5845 end;
5846
5847 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5848 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5849 procedure TglBitmap.SavePNG(const aStream: TStream);
5850 var
5851   Png: TPNGObject;
5852
5853   pSource, pDest: pByte;
5854   X, Y, PixSize: Integer;
5855   ColorType: Cardinal;
5856   Alpha: Boolean;
5857
5858   pTemp: pByte;
5859   Temp: Byte;
5860 begin
5861   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
5862     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5863
5864   case FInternalFormat of
5865     ifAlpha, ifLuminance, ifDepth8: begin
5866       ColorType := COLOR_GRAYSCALE;
5867       PixSize := 1;
5868       Alpha := false;
5869     end;
5870     ifLuminanceAlpha: begin
5871       ColorType := COLOR_GRAYSCALEALPHA;
5872       PixSize := 1;
5873       Alpha := true;
5874     end;
5875     ifBGR8, ifRGB8: begin
5876       ColorType := COLOR_RGB;
5877       PixSize := 3;
5878       Alpha := false;
5879     end;
5880     ifBGRA8, ifRGBA8: begin
5881       ColorType := COLOR_RGBALPHA;
5882       PixSize := 3;
5883       Alpha := true
5884     end;
5885   else
5886     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5887   end;
5888
5889   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5890   try
5891     // Copy ImageData
5892     pSource := Data;
5893     for Y := 0 to Height -1 do begin
5894       pDest := png.ScanLine[Y];
5895       for X := 0 to Width -1 do begin
5896         Move(pSource^, pDest^, PixSize);
5897         Inc(pDest, PixSize);
5898         Inc(pSource, PixSize);
5899         if Alpha then begin
5900           png.AlphaScanline[Y]^[X] := pSource^;
5901           Inc(pSource);
5902         end;
5903       end;
5904
5905       // convert RGB line to BGR
5906       if InternalFormat in [ifRGB8, ifRGBA8] then begin
5907         pTemp := png.ScanLine[Y];
5908         for X := 0 to Width -1 do begin
5909           Temp := pByteArray(pTemp)^[0];
5910           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5911           pByteArray(pTemp)^[2] := Temp;
5912           Inc(pTemp, 3);
5913         end;
5914       end;
5915     end;
5916
5917     // Save to Stream
5918     Png.CompressionLevel := 6;
5919     Png.SaveToStream(Stream);
5920   finally
5921     FreeAndNil(Png);
5922   end;
5923 end;
5924 {$IFEND}
5925 {$ENDIF}
5926
5927 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5928 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5929 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5930 {$IFDEF GLB_LIB_JPEG}
5931 type
5932   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
5933   glBitmap_libJPEG_source_mgr = record
5934     pub: jpeg_source_mgr;
5935
5936     SrcStream: TStream;
5937     SrcBuffer: array [1..4096] of byte;
5938   end;
5939
5940   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
5941   glBitmap_libJPEG_dest_mgr = record
5942     pub: jpeg_destination_mgr;
5943
5944     DestStream: TStream;
5945     DestBuffer: array [1..4096] of byte;
5946   end;
5947
5948 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5949 {
5950 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
5951 var
5952   Msg: String;
5953 begin
5954   SetLength(Msg, 256);
5955   cinfo^.err^.format_message(cinfo, pChar(Msg));
5956   Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
5957   cinfo^.global_state := 0;
5958   jpeg_abort(cinfo);
5959 end;
5960 }
5961
5962 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5963 {
5964 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
5965 var
5966   Msg: String;
5967 begin
5968   SetLength(Msg, 256);
5969   cinfo^.err^.format_message(cinfo, pChar(Msg));
5970   Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
5971   cinfo^.global_state := 0;
5972 end;
5973 }
5974
5975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5976 {
5977 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
5978 begin
5979 end;
5980 }
5981
5982 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5983 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
5984 var
5985   src: glBitmap_libJPEG_source_mgr_ptr;
5986   bytes: integer;
5987 begin
5988   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5989
5990   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
5991         if (bytes <= 0) then begin
5992                 src^.SrcBuffer[1] := $FF;
5993                 src^.SrcBuffer[2] := JPEG_EOI;
5994                 bytes := 2;
5995         end;
5996
5997         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
5998         src^.pub.bytes_in_buffer := bytes;
5999
6000   result := true;
6001 end;
6002
6003 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6004 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6005 var
6006   src: glBitmap_libJPEG_source_mgr_ptr;
6007 begin
6008   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6009
6010   if num_bytes > 0 then begin
6011     // wanted byte isn't in buffer so set stream position and read buffer
6012     if num_bytes > src^.pub.bytes_in_buffer then begin
6013       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6014       src^.pub.fill_input_buffer(cinfo);
6015     end else begin
6016       // wanted byte is in buffer so only skip
6017                 inc(src^.pub.next_input_byte, num_bytes);
6018                 dec(src^.pub.bytes_in_buffer, num_bytes);
6019     end;
6020   end;
6021 end;
6022
6023 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6024 {
6025 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6026 begin
6027 end;
6028 }
6029
6030 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6031 {
6032 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6033 begin
6034 end;
6035 }
6036
6037 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6038 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6039 var
6040   dest: glBitmap_libJPEG_dest_mgr_ptr;
6041 begin
6042   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6043
6044   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6045     // write complete buffer
6046     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6047
6048     // reset buffer
6049     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6050     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6051   end;
6052
6053   result := true;
6054 end;
6055
6056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6057 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6058 var
6059   Idx: Integer;
6060   dest: glBitmap_libJPEG_dest_mgr_ptr;
6061 begin
6062   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6063
6064   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6065     // check for endblock
6066     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6067       // write endblock
6068       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6069
6070       // leave
6071       break;
6072     end else
6073       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6074   end;
6075 end;
6076 {$ENDIF}
6077
6078 {$IFDEF GLB_SUPPORT_JPEG_READ}
6079 {$IF DEFINED(GLB_SDL_IMAGE)}
6080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6081 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6082 var
6083   Surface: PSDL_Surface;
6084   RWops: PSDL_RWops;
6085 begin
6086   result := false;
6087
6088   RWops := glBitmapCreateRWops(Stream);
6089   try
6090     if IMG_isJPG(RWops) > 0 then begin
6091       Surface := IMG_LoadJPG_RW(RWops);
6092       try
6093         AssignFromSurface(Surface);
6094         result := true;
6095       finally
6096         SDL_FreeSurface(Surface);
6097       end;
6098     end;
6099   finally
6100     SDL_FreeRW(RWops);
6101   end;
6102 end;
6103
6104 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6105 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6106 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6107 var
6108   StreamPos: Int64;
6109   Temp: array[0..1]of Byte;
6110
6111   jpeg: jpeg_decompress_struct;
6112   jpeg_err: jpeg_error_mgr;
6113
6114   IntFormat: TglBitmapInternalFormat;
6115   pImage: pByte;
6116   TempHeight, TempWidth: Integer;
6117
6118   pTemp: pByte;
6119   Row: Integer;
6120 begin
6121   result := false;
6122
6123   if not init_libJPEG then
6124     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6125
6126   try
6127     // reading first two bytes to test file and set cursor back to begin
6128     StreamPos := Stream.Position;
6129     Stream.Read(Temp[0], 2);
6130     Stream.Position := StreamPos;
6131
6132     // if Bitmap then read file.
6133     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6134       FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
6135       FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
6136
6137       // error managment
6138       jpeg.err := jpeg_std_error(@jpeg_err);
6139       jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
6140       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6141
6142       // decompression struct
6143       jpeg_create_decompress(@jpeg);
6144
6145       // allocation space for streaming methods
6146       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6147
6148       // seeting up custom functions
6149       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6150         pub.init_source       := glBitmap_libJPEG_init_source;
6151         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6152         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6153         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6154         pub.term_source       := glBitmap_libJPEG_term_source;
6155
6156         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6157         pub.next_input_byte := nil;   // until buffer loaded
6158
6159         SrcStream := Stream;
6160       end;
6161
6162       // set global decoding state
6163       jpeg.global_state := DSTATE_START;
6164
6165       // read header of jpeg
6166       jpeg_read_header(@jpeg, false);
6167
6168       // setting output parameter
6169       case jpeg.jpeg_color_space of
6170         JCS_GRAYSCALE:
6171           begin
6172             jpeg.out_color_space := JCS_GRAYSCALE;
6173             IntFormat := ifLuminance;
6174           end;
6175         else
6176           jpeg.out_color_space := JCS_RGB;
6177           IntFormat := ifRGB8;
6178       end;
6179
6180       // reading image
6181       jpeg_start_decompress(@jpeg);
6182
6183       TempHeight := jpeg.output_height;
6184       TempWidth := jpeg.output_width;
6185
6186       // creating new image
6187       GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
6188       try
6189         pTemp := pImage;
6190
6191         for Row := 0 to TempHeight -1 do begin
6192           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6193           Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
6194         end;
6195
6196         // finish decompression
6197         jpeg_finish_decompress(@jpeg);
6198
6199         // destroy decompression
6200         jpeg_destroy_decompress(@jpeg);
6201
6202         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
6203
6204         result := true;
6205       except
6206         FreeMem(pImage);
6207         raise;
6208       end;
6209     end;
6210   finally
6211     quit_libJPEG;
6212   end;
6213 end;
6214
6215 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6216 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6217 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6218 var
6219   bmp: TBitmap;
6220   jpg: TJPEGImage;
6221   StreamPos: Int64;
6222   Temp: array[0..1]of Byte;
6223 begin
6224   result := false;
6225
6226   // reading first two bytes to test file and set cursor back to begin
6227   StreamPos := Stream.Position;
6228   Stream.Read(Temp[0], 2);
6229   Stream.Position := StreamPos;
6230
6231   // if Bitmap then read file.
6232   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6233     bmp := TBitmap.Create;
6234     try
6235       jpg := TJPEGImage.Create;
6236       try
6237         jpg.LoadFromStream(Stream);
6238         bmp.Assign(jpg);
6239         result := AssignFromBitmap(bmp);
6240       finally
6241         jpg.Free;
6242       end;
6243     finally
6244       bmp.Free;
6245     end;
6246   end;
6247 end;
6248 {$IFEND}
6249 {$ENDIF}
6250
6251 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6252 {$IF DEFEFINED(GLB_LIB_JPEG)}
6253 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6254 procedure TglBitmap.SaveJPEG(Stream: TStream);
6255 var
6256   jpeg: jpeg_compress_struct;
6257   jpeg_err: jpeg_error_mgr;
6258   Row: Integer;
6259   pTemp, pTemp2: pByte;
6260
6261   procedure CopyRow(pDest, pSource: pByte);
6262   var
6263     X: Integer;
6264   begin
6265     for X := 0 to Width - 1 do begin
6266       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6267       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6268       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6269       Inc(pDest, 3);
6270       Inc(pSource, 3);
6271     end;
6272   end;
6273
6274 begin
6275   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6276     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
6277
6278   if not init_libJPEG then
6279     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6280
6281   try
6282     FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
6283     FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
6284
6285     // error managment
6286     jpeg.err := jpeg_std_error(@jpeg_err);
6287     jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
6288     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6289
6290     // compression struct
6291     jpeg_create_compress(@jpeg);
6292
6293     // allocation space for streaming methods
6294     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6295
6296     // seeting up custom functions
6297     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6298       pub.init_destination    := glBitmap_libJPEG_init_destination;
6299       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6300       pub.term_destination    := glBitmap_libJPEG_term_destination;
6301
6302       pub.next_output_byte  := @DestBuffer[1];
6303       pub.free_in_buffer    := Length(DestBuffer);
6304
6305       DestStream := Stream;
6306     end;
6307
6308     // very important state
6309     jpeg.global_state := CSTATE_START;
6310     jpeg.image_width  := Width;
6311     jpeg.image_height := Height;
6312     case InternalFormat of
6313       ifAlpha, ifLuminance, ifDepth8: begin
6314         jpeg.input_components := 1;
6315         jpeg.in_color_space := JCS_GRAYSCALE;
6316       end;
6317       ifRGB8, ifBGR8: begin
6318         jpeg.input_components := 3;
6319         jpeg.in_color_space := JCS_RGB;
6320       end;
6321     end;
6322
6323     jpeg_set_defaults(@jpeg);
6324     jpeg_set_quality(@jpeg, 95, true);
6325     jpeg_start_compress(@jpeg, true);
6326     pTemp := Data;
6327
6328     if InternalFormat = ifBGR8 then
6329       GetMem(pTemp2, fRowSize)
6330     else
6331       pTemp2 := pTemp;
6332
6333     try
6334       for Row := 0 to jpeg.image_height -1 do begin
6335         // prepare row
6336         if InternalFormat = ifBGR8 then
6337           CopyRow(pTemp2, pTemp)
6338         else
6339           pTemp2 := pTemp;
6340
6341         // write row
6342         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6343         inc(pTemp, fRowSize);
6344       end;
6345     finally
6346       // free memory
6347       if InternalFormat = ifBGR8 then
6348         FreeMem(pTemp2);
6349     end;
6350     jpeg_finish_compress(@jpeg);
6351     jpeg_destroy_compress(@jpeg);
6352   finally
6353     quit_libJPEG;
6354   end;
6355 end;
6356
6357 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6359 procedure TglBitmap.SaveJPEG(Stream: TStream);
6360 var
6361   Bmp: TBitmap;
6362   Jpg: TJPEGImage;
6363 begin
6364   if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
6365     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
6366
6367   Bmp := TBitmap.Create;
6368   try
6369     Jpg := TJPEGImage.Create;
6370     try
6371       AssignToBitmap(Bmp);
6372       if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
6373         Jpg.Grayscale := true;
6374         Jpg.PixelFormat := jf8Bit;
6375       end;
6376       Jpg.Assign(Bmp);
6377       Jpg.SaveToStream(Stream);
6378     finally
6379       FreeAndNil(Jpg);
6380     end;
6381   finally
6382     FreeAndNil(Bmp);
6383   end;
6384 end;
6385 {$ENDIF}
6386 {$ENDIF}
6387
6388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6389 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6390 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6391 const
6392   BMP_MAGIC          = $4D42;
6393
6394   BMP_COMP_RGB       = 0;
6395   BMP_COMP_RLE8      = 1;
6396   BMP_COMP_RLE4      = 2;
6397   BMP_COMP_BITFIELDS = 3;
6398
6399 type
6400   TBMPHeader = packed record
6401     bfType: Word;
6402     bfSize: Cardinal;
6403     bfReserved1: Word;
6404     bfReserved2: Word;
6405     bfOffBits: Cardinal;
6406   end;
6407
6408   TBMPInfo = packed record
6409     biSize: Cardinal;
6410     biWidth: Longint;
6411     biHeight: Longint;
6412     biPlanes: Word;
6413     biBitCount: Word;
6414     biCompression: Cardinal;
6415     biSizeImage: Cardinal;
6416     biXPelsPerMeter: Longint;
6417     biYPelsPerMeter: Longint;
6418     biClrUsed: Cardinal;
6419     biClrImportant: Cardinal;
6420   end;
6421
6422 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6423 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6424
6425   //////////////////////////////////////////////////////////////////////////////////////////////////
6426   function ReadInfo(var aInfo: TBMPInfo; var aMask: TglBitmapColorRec): TglBitmapFormat;
6427   begin
6428     result := tfEmpty;
6429     aStream.Read(aInfo, SizeOf(aInfo));
6430     FillChar(aMask, SizeOf(aMask), 0);
6431
6432     //Read Compression
6433     case aInfo.biCompression of
6434       BMP_COMP_RLE4,
6435       BMP_COMP_RLE8: begin
6436         raise EglBitmapException.Create('RLE compression is not supported');
6437       end;
6438       BMP_COMP_BITFIELDS: begin
6439         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6440           aStream.Read(aMask.r, SizeOf(aMask.r));
6441           aStream.Read(aMask.g, SizeOf(aMask.g));
6442           aStream.Read(aMask.b, SizeOf(aMask.b));
6443           aStream.Read(aMask.a, SizeOf(aMask.a));
6444         end else
6445           raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
6446       end;
6447     end;
6448
6449     //get suitable format
6450     case aInfo.biBitCount of
6451        8: result := tfLuminance8;
6452       16: result := tfBGR5;
6453       24: result := tfBGR8;
6454       32: result := tfBGRA8;
6455     end;
6456   end;
6457
6458   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6459   var
6460     i, c: Integer;
6461     ColorTable: TbmpColorTable;
6462   begin
6463     result := nil;
6464     if (aInfo.biBitCount >= 16) then
6465       exit;
6466     aFormat := tfLuminance8;
6467     c := aInfo.biClrUsed;
6468     if (c = 0) then
6469       c := 1 shl aInfo.biBitCount;
6470     SetLength(ColorTable, c);
6471     for i := 0 to c-1 do begin
6472       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6473       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6474         aFormat := tfRGB8;
6475     end;
6476
6477     result := TbmpColorTableFormat.Create;
6478     result.PixelSize  := aInfo.biBitCount / 8;
6479     result.ColorTable := ColorTable;
6480     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6481   end;
6482
6483   //////////////////////////////////////////////////////////////////////////////////////////////////
6484   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6485     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6486   var
6487     TmpFormat: TglBitmapFormat;
6488     FormatDesc: TFormatDescriptor;
6489   begin
6490     result := nil;
6491     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6492       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6493         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6494         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6495           aFormat := FormatDesc.Format;
6496           exit;
6497         end;
6498       end;
6499
6500       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6501         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6502       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6503         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6504
6505       result := TbmpBitfieldFormat.Create;
6506       result.PixelSize := aInfo.biBitCount / 8;
6507       result.RedMask   := aMask.r;
6508       result.GreenMask := aMask.g;
6509       result.BlueMask  := aMask.b;
6510       result.AlphaMask := aMask.a;
6511     end;
6512   end;
6513
6514 var
6515   //simple types
6516   StartPos: Int64;
6517   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6518   PaddingBuff: Cardinal;
6519   LineBuf, ImageData, TmpData: PByte;
6520   SourceMD, DestMD: Pointer;
6521   BmpFormat: TglBitmapFormat;
6522   ColorTable: TbmpColorTable;
6523
6524   //records
6525   Mask: TglBitmapColorRec;
6526   Header: TBMPHeader;
6527   Info: TBMPInfo;
6528
6529   //classes
6530   SpecialFormat: TFormatDescriptor;
6531   FormatDesc: TFormatDescriptor;
6532
6533   //////////////////////////////////////////////////////////////////////////////////////////////////
6534   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6535   var
6536     i, j: Integer;
6537     Pixel: TglBitmapPixelData;
6538   begin
6539     aStream.Read(aLineBuf^, rbLineSize);
6540     SpecialFormat.PreparePixel(Pixel);
6541     for i := 0 to Info.biWidth-1 do begin
6542       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6543       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6544       FormatDesc.Map(Pixel, aData, DestMD);
6545     end;
6546   end;
6547
6548 begin
6549   result        := false;
6550   BmpFormat     := tfEmpty;
6551   SpecialFormat := nil;
6552   LineBuf       := nil;
6553   SourceMD      := nil;
6554   DestMD        := nil;
6555
6556   // Header
6557   StartPos := aStream.Position;
6558   aStream.Read(Header, SizeOf(Header));
6559
6560   if Header.bfType = BMP_MAGIC then begin
6561     try try
6562       BmpFormat        := ReadInfo(Info, Mask);
6563       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6564       if not Assigned(SpecialFormat) then
6565         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6566       aStream.Position := StartPos + Header.bfOffBits;
6567
6568       if (BmpFormat <> tfEmpty) then begin
6569         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6570         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6571         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6572         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6573
6574         //get Memory
6575         DestMD    := FormatDesc.CreateMappingData;
6576         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6577         GetMem(ImageData, ImageSize);
6578         if Assigned(SpecialFormat) then begin
6579           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6580           SourceMD := SpecialFormat.CreateMappingData;
6581         end;
6582
6583         //read Data
6584         try try
6585           FillChar(ImageData^, ImageSize, $FF);
6586           TmpData := ImageData;
6587           if (Info.biHeight > 0) then
6588             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6589           for i := 0 to Abs(Info.biHeight)-1 do begin
6590             if Assigned(SpecialFormat) then
6591               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6592             else
6593               aStream.Read(TmpData^, wbLineSize);   //else only read data
6594             if (Info.biHeight > 0) then
6595               dec(TmpData, wbLineSize)
6596             else
6597               inc(TmpData, wbLineSize);
6598             aStream.Read(PaddingBuff, Padding);
6599           end;
6600           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
6601           result := true;
6602         finally
6603           if Assigned(LineBuf) then
6604             FreeMem(LineBuf);
6605           if Assigned(SourceMD) then
6606             SpecialFormat.FreeMappingData(SourceMD);
6607           FormatDesc.FreeMappingData(DestMD);
6608         end;
6609         except
6610           FreeMem(ImageData);
6611           raise;
6612         end;
6613       end else
6614         raise EglBitmapException.Create('LoadBMP - No suitable format found');
6615     except
6616       aStream.Position := StartPos;
6617       raise;
6618     end;
6619     finally
6620       FreeAndNil(SpecialFormat);
6621     end;
6622   end
6623     else aStream.Position := StartPos;
6624 end;
6625
6626 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6627 procedure TglBitmap.SaveBMP(const aStream: TStream);
6628 var
6629   Header: TBMPHeader;
6630   Info: TBMPInfo;
6631   Converter: TbmpColorTableFormat;
6632   FormatDesc: TFormatDescriptor;
6633   SourceFD, DestFD: Pointer;
6634   pData, srcData, dstData, ConvertBuffer: pByte;
6635
6636   Pixel: TglBitmapPixelData;
6637   PixelFormat: TglBitmapPixelData;
6638   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx, i: Integer;
6639   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6640
6641   PaddingBuff: Cardinal;
6642
6643   function GetLineWidth : Integer;
6644   begin
6645     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6646   end;
6647
6648 begin
6649   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6650     raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
6651
6652   Converter  := nil;
6653   FormatDesc := TFormatDescriptor.Get(Format);
6654   ImageSize  := FormatDesc.GetSize(Dimension);
6655
6656   FillChar(Header, SizeOf(Header), 0);
6657   Header.bfType      := BMP_MAGIC;
6658   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6659   Header.bfReserved1 := 0;
6660   Header.bfReserved2 := 0;
6661   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6662
6663   FillChar(Info, SizeOf(Info), 0);
6664   Info.biSize        := SizeOf(Info);
6665   Info.biWidth       := Width;
6666   Info.biHeight      := Height;
6667   Info.biPlanes      := 1;
6668   Info.biCompression := BMP_COMP_RGB;
6669   Info.biSizeImage   := ImageSize;
6670
6671   try
6672     case Format of
6673       tfLuminance4: begin
6674         Info.biBitCount  := 4;
6675         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6676         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6677         Converter           := TbmpColorTableFormat.Create;
6678         Converter.PixelSize := 0.5;
6679         Converter.Format    := Format;
6680         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);
6681         Converter.CreateColorTable;
6682       end;
6683
6684       tfR3G3B2, tfLuminance8: begin
6685         Info.biBitCount  :=  8;
6686         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6687         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6688         Converter           := TbmpColorTableFormat.Create;
6689         Converter.PixelSize := 1;
6690         Converter.Format    := Format;
6691         if (Format = tfR3G3B2) then begin
6692           Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6693           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6694         end else
6695           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6696         Converter.CreateColorTable;
6697       end;
6698
6699       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6700       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6701         Info.biBitCount    := 16;
6702         Info.biCompression := BMP_COMP_BITFIELDS;
6703       end;
6704
6705       tfBGR8, tfRGB8: begin
6706         Info.biBitCount := 24;
6707       end;
6708
6709       tfRGB10, tfRGB10A2, tfRGBA8,
6710       tfBGR10, tfBGR10A2, tfBGRA8: begin
6711         Info.biBitCount    := 32;
6712         Info.biCompression := BMP_COMP_BITFIELDS;
6713       end;
6714     else
6715       raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
6716     end;
6717     Info.biXPelsPerMeter := 2835;
6718     Info.biYPelsPerMeter := 2835;
6719
6720     // prepare bitmasks
6721     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6722       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
6723       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6724
6725       RedMask    := FormatDesc.RedMask;
6726       GreenMask  := FormatDesc.GreenMask;
6727       BlueMask   := FormatDesc.BlueMask;
6728       AlphaMask  := FormatDesc.AlphaMask;
6729     end;
6730
6731     // headers
6732     aStream.Write(Header, SizeOf(Header));
6733     aStream.Write(Info, SizeOf(Info));
6734
6735     // colortable
6736     if Assigned(Converter) then
6737       aStream.Write(Converter.ColorTable[0].b,
6738         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6739
6740     // bitmasks
6741     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6742       aStream.Write(RedMask,   SizeOf(Cardinal));
6743       aStream.Write(GreenMask, SizeOf(Cardinal));
6744       aStream.Write(BlueMask,  SizeOf(Cardinal));
6745       aStream.Write(AlphaMask, SizeOf(Cardinal));
6746     end;
6747
6748     // image data
6749     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
6750     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
6751     Padding     := GetLineWidth - wbLineSize;
6752     PaddingBuff := 0;
6753
6754     pData := Data;
6755     inc(pData, (Height-1) * rbLineSize);
6756
6757     // prepare row buffer. But only for RGB because RGBA supports color masks
6758     // so it's possible to change color within the image.
6759     if Assigned(Converter) then begin
6760       FormatDesc.PreparePixel(Pixel);
6761       GetMem(ConvertBuffer, wbLineSize);
6762       SourceFD := FormatDesc.CreateMappingData;
6763       DestFD   := Converter.CreateMappingData;
6764     end else
6765       ConvertBuffer := nil;
6766
6767     try
6768       for LineIdx := 0 to Height - 1 do begin
6769         // preparing row
6770         if Assigned(Converter) then begin
6771           srcData := pData;
6772           dstData := ConvertBuffer;
6773           for PixelIdx := 0 to Info.biWidth-1 do begin
6774             FormatDesc.Unmap(srcData, Pixel, SourceFD);
6775             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
6776             Converter.Map(Pixel, dstData, DestFD);
6777           end;
6778           aStream.Write(ConvertBuffer^, wbLineSize);
6779         end else begin
6780           aStream.Write(pData^, rbLineSize);
6781         end;
6782         dec(pData, rbLineSize);
6783         if (Padding > 0) then
6784           aStream.Write(PaddingBuff, Padding);
6785       end;
6786     finally
6787       // destroy row buffer
6788       if Assigned(ConvertBuffer) then begin
6789         FormatDesc.FreeMappingData(SourceFD);
6790         Converter.FreeMappingData(DestFD);
6791         FreeMem(ConvertBuffer);
6792       end;
6793     end;
6794   finally
6795     if Assigned(Converter) then
6796       Converter.Free;
6797   end;
6798 end;
6799
6800 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6801 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6802 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6803 type
6804   TTGAHeader = packed record
6805     ImageID: Byte;
6806     ColorMapType: Byte;
6807     ImageType: Byte;
6808     //ColorMapSpec: Array[0..4] of Byte;
6809     ColorMapStart: Word;
6810     ColorMapLength: Word;
6811     ColorMapEntrySize: Byte;
6812     OrigX: Word;
6813     OrigY: Word;
6814     Width: Word;
6815     Height: Word;
6816     Bpp: Byte;
6817     ImageDesc: Byte;
6818   end;
6819
6820 const
6821   TGA_UNCOMPRESSED_RGB  =  2;
6822   TGA_UNCOMPRESSED_GRAY =  3;
6823   TGA_COMPRESSED_RGB    = 10;
6824   TGA_COMPRESSED_GRAY   = 11;
6825
6826   TGA_NONE_COLOR_TABLE  = 0;
6827
6828 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6829 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6830 var
6831   Header: TTGAHeader;
6832   ImageData: PByte;
6833   StartPosition: Int64;
6834   PixelSize, LineSize: Integer;
6835   tgaFormat: TglBitmapFormat;
6836   FormatDesc: TFormatDescriptor;
6837   Counter: packed record
6838     X, Y: packed record
6839       low, high, dir: Integer;
6840     end;
6841   end;
6842
6843 const
6844   CACHE_SIZE = $4000;
6845
6846   ////////////////////////////////////////////////////////////////////////////////////////
6847   procedure ReadUncompressed;
6848   var
6849     i, j: Integer;
6850     buf, tmp1, tmp2: PByte;
6851   begin
6852     buf := nil;
6853     if (Counter.X.dir < 0) then
6854       buf := GetMem(LineSize);
6855     try
6856       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
6857         tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
6858         if (Counter.X.dir < 0) then begin               //flip X
6859           aStream.Read(buf^, LineSize);
6860           tmp2 := buf + LineSize - PixelSize;           //pointer to last pixel in line
6861           for i := 0 to Header.Width-1 do begin         //for all pixels in line
6862             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
6863               tmp1^ := tmp2^;
6864               inc(tmp1);
6865               inc(tmp2);
6866             end;
6867             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
6868           end;
6869         end else
6870           aStream.Read(tmp1^, LineSize);
6871         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
6872       end;
6873     finally
6874       if Assigned(buf) then
6875         FreeMem(buf);
6876     end;
6877   end;
6878
6879   ////////////////////////////////////////////////////////////////////////////////////////
6880   procedure ReadCompressed;
6881
6882     /////////////////////////////////////////////////////////////////
6883     var
6884       TmpData: PByte;
6885       LinePixelsRead: Integer;
6886     procedure CheckLine;
6887     begin
6888       if (LinePixelsRead >= Header.Width) then begin
6889         LinePixelsRead := 0;
6890         inc(Counter.Y.low, Counter.Y.dir);                //next line index
6891         TmpData := ImageData + Counter.Y.low * LineSize;  //set line
6892         if (Counter.X.dir < 0) then                       //if x flipped then
6893           TmpData := TmpData + LineSize - PixelSize;      //set last pixel
6894       end;
6895     end;
6896
6897     /////////////////////////////////////////////////////////////////
6898     var
6899       Cache: PByte;
6900       CacheSize, CachePos: Integer;
6901     procedure CachedRead(out Buffer; Count: Integer);
6902     var
6903       BytesRead: Integer;
6904     begin
6905       if (CachePos + Count > CacheSize) then begin
6906         //if buffer overflow save non read bytes
6907         BytesRead := 0;
6908         if (CacheSize - CachePos > 0) then begin
6909           BytesRead := CacheSize - CachePos;
6910           Move(PByteArray(Cache)^[CachePos], Buffer, BytesRead);
6911           inc(CachePos, BytesRead);
6912         end;
6913
6914         //load cache from file
6915         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6916         aStream.Read(Cache^, CacheSize);
6917         CachePos := 0;
6918
6919         //read rest of requested bytes
6920         if (Count - BytesRead > 0) then begin
6921           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6922           inc(CachePos, Count - BytesRead);
6923         end;
6924       end else begin
6925         //if no buffer overflow just read the data
6926         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6927         inc(CachePos, Count);
6928       end;
6929     end;
6930
6931     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6932     begin
6933       case PixelSize of
6934         1: begin
6935           aBuffer^ := aData^;
6936           inc(aBuffer, Counter.X.dir);
6937         end;
6938         2: begin
6939           PWord(aBuffer)^ := PWord(aData)^;
6940           inc(aBuffer, 2 * Counter.X.dir);
6941         end;
6942         3: begin
6943           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6944           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6945           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6946           inc(aBuffer, 3 * Counter.X.dir);
6947         end;
6948         4: begin
6949           PCardinal(aBuffer)^ := PCardinal(aData)^;
6950           inc(aBuffer, 4 * Counter.X.dir);
6951         end;
6952       end;
6953     end;
6954
6955   var
6956     TotalPixelsToRead, TotalPixelsRead: Integer;
6957     Temp: Byte;
6958     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6959     PixelRepeat: Boolean;
6960     PixelsToRead, PixelCount: Integer;
6961   begin
6962     CacheSize := 0;
6963     CachePos  := 0;
6964
6965     TotalPixelsToRead := Header.Width * Header.Height;
6966     TotalPixelsRead   := 0;
6967     LinePixelsRead    := 0;
6968
6969     GetMem(Cache, CACHE_SIZE);
6970     try
6971       TmpData := ImageData + Counter.Y.low * LineSize;  //set line
6972       if (Counter.X.dir < 0) then                       //if x flipped then
6973         TmpData := TmpData + LineSize - PixelSize;      //set last pixel
6974
6975       repeat
6976         //read CommandByte
6977         CachedRead(Temp, 1);
6978         PixelRepeat  := (Temp and $80) > 0;
6979         PixelsToRead := (Temp and $7F) + 1;
6980         inc(TotalPixelsRead, PixelsToRead);
6981
6982         if PixelRepeat then
6983           CachedRead(buf[0], PixelSize);
6984         while (PixelsToRead > 0) do begin
6985           CheckLine;
6986           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6987           while (PixelCount > 0) do begin
6988             if not PixelRepeat then
6989               CachedRead(buf[0], PixelSize);
6990             PixelToBuffer(@buf[0], TmpData);
6991             inc(LinePixelsRead);
6992             dec(PixelsToRead);
6993             dec(PixelCount);
6994           end;
6995         end;
6996       until (TotalPixelsRead >= TotalPixelsToRead);
6997     finally
6998       FreeMem(Cache);
6999     end;
7000   end;
7001
7002   function IsGrayFormat: Boolean;
7003   begin
7004     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7005   end;
7006
7007 begin
7008   result := false;
7009
7010   // reading header to test file and set cursor back to begin
7011   StartPosition := aStream.Position;
7012   aStream.Read(Header, SizeOf(Header));
7013
7014   // no colormapped files
7015   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7016     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7017   begin
7018     try
7019       if Header.ImageID <> 0 then       // skip image ID
7020         aStream.Position := aStream.Position + Header.ImageID;
7021
7022       case Header.Bpp of
7023          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7024                0: tgaFormat := tfLuminance8;
7025                8: tgaFormat := tfAlpha8;
7026             end;
7027
7028         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7029                0: tgaFormat := tfLuminance16;
7030                8: tgaFormat := tfLuminance8Alpha8;
7031             end else case (Header.ImageDesc and $F) of
7032                0: tgaFormat := tfBGR5;
7033                1: tgaFormat := tfBGR5A1;
7034                4: tgaFormat := tfBGRA4;
7035             end;
7036
7037         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7038                0: tgaFormat := tfBGR8;
7039             end;
7040
7041         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7042                2: tgaFormat := tfBGR10A2;
7043                8: tgaFormat := tfBGRA8;
7044             end;
7045       end;
7046
7047       if (tgaFormat = tfEmpty) then
7048         raise EglBitmapException.Create('LoadTga - unsupported format');
7049
7050       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7051       PixelSize  := FormatDesc.GetSize(1, 1);
7052       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7053
7054       GetMem(ImageData, LineSize * Header.Height);
7055       try
7056         //column direction
7057         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7058           Counter.X.low  := Header.Height-1;;
7059           Counter.X.high := 0;
7060           Counter.X.dir  := -1;
7061         end else begin
7062           Counter.X.low  := 0;
7063           Counter.X.high := Header.Height-1;
7064           Counter.X.dir  := 1;
7065         end;
7066
7067         // Row direction
7068         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7069           Counter.Y.low  := 0;
7070           Counter.Y.high := Header.Height-1;
7071           Counter.Y.dir  := 1;
7072         end else begin
7073           Counter.Y.low  := Header.Height-1;;
7074           Counter.Y.high := 0;
7075           Counter.Y.dir  := -1;
7076         end;
7077
7078         // Read Image
7079         case Header.ImageType of
7080           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7081             ReadUncompressed;
7082           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7083             ReadCompressed;
7084         end;
7085
7086         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
7087         result := true;
7088       except
7089         FreeMem(ImageData);
7090         raise;
7091       end;
7092     finally
7093       aStream.Position := StartPosition;
7094     end;
7095   end
7096     else aStream.Position := StartPosition;
7097 end;
7098
7099 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7100 procedure TglBitmap.SaveTGA(const aStream: TStream);
7101 var
7102   Header: TTGAHeader;
7103   LineSize, Size, x, y: Integer;
7104   Pixel: TglBitmapPixelData;
7105   LineBuf, SourceData, DestData: PByte;
7106   SourceMD, DestMD: Pointer;
7107   FormatDesc: TFormatDescriptor;
7108   Converter: TFormatDescriptor;
7109 begin
7110   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7111     raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);
7112
7113   //prepare header
7114   FillChar(Header, SizeOf(Header), 0);
7115
7116   //set ImageType
7117   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7118                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7119     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7120   else
7121     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7122
7123   //set BitsPerPixel
7124   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7125     Header.Bpp := 8
7126   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7127                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7128     Header.Bpp := 16
7129   else if (Format in [tfBGR8, tfRGB8]) then
7130     Header.Bpp := 24
7131   else
7132     Header.Bpp := 32;
7133
7134   //set AlphaBitCount
7135   case Format of
7136     tfRGB5A1, tfBGR5A1:
7137       Header.ImageDesc := 1 and $F;
7138     tfRGB10A2, tfBGR10A2:
7139       Header.ImageDesc := 2 and $F;
7140     tfRGBA4, tfBGRA4:
7141       Header.ImageDesc := 4 and $F;
7142     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7143       Header.ImageDesc := 8 and $F;
7144   end;
7145
7146   Header.Width     := Width;
7147   Header.Height    := Height;
7148   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7149   aStream.Write(Header, SizeOf(Header));
7150
7151   // convert RGB(A) to BGR(A)
7152   Converter  := nil;
7153   FormatDesc := TFormatDescriptor.Get(Format);
7154   Size       := FormatDesc.GetSize(Dimension);
7155   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7156     if (FormatDesc.RGBInverted = tfEmpty) then
7157       raise EglBitmapException.Create('inverted RGB format is empty');
7158     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7159     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7160        (Converter.PixelSize <> FormatDesc.PixelSize) then
7161       raise EglBitmapException.Create('invalid inverted RGB format');
7162   end;
7163
7164   if Assigned(Converter) then begin
7165     LineSize := FormatDesc.GetSize(Width, 1);
7166     LineBuf  := GetMem(LineSize);
7167     SourceMD := FormatDesc.CreateMappingData;
7168     DestMD   := Converter.CreateMappingData;
7169     try
7170       SourceData := Data;
7171       for y := 0 to Height-1 do begin
7172         DestData := LineBuf;
7173         for x := 0 to Width-1 do begin
7174           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7175           Converter.Map(Pixel, DestData, DestMD);
7176         end;
7177         aStream.Write(LineBuf^, LineSize);
7178       end;
7179     finally
7180       FreeMem(LineBuf);
7181       FormatDesc.FreeMappingData(SourceMD);
7182       FormatDesc.FreeMappingData(DestMD);
7183     end;
7184   end else
7185     aStream.Write(Data^, Size);
7186 end;
7187
7188 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7189 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7191 const
7192   DDS_MAGIC: Cardinal         = $20534444;
7193
7194   // DDS_header.dwFlags
7195   DDSD_CAPS                   = $00000001;
7196   DDSD_HEIGHT                 = $00000002;
7197   DDSD_WIDTH                  = $00000004;
7198   DDSD_PIXELFORMAT            = $00001000;
7199
7200   // DDS_header.sPixelFormat.dwFlags
7201   DDPF_ALPHAPIXELS            = $00000001;
7202   DDPF_ALPHA                  = $00000002;
7203   DDPF_FOURCC                 = $00000004;
7204   DDPF_RGB                    = $00000040;
7205   DDPF_LUMINANCE              = $00020000;
7206
7207   // DDS_header.sCaps.dwCaps1
7208   DDSCAPS_TEXTURE             = $00001000;
7209
7210   // DDS_header.sCaps.dwCaps2
7211   DDSCAPS2_CUBEMAP            = $00000200;
7212
7213   D3DFMT_DXT1                 = $31545844;
7214   D3DFMT_DXT3                 = $33545844;
7215   D3DFMT_DXT5                 = $35545844;
7216
7217 type
7218   TDDSPixelFormat = packed record
7219     dwSize: Cardinal;
7220     dwFlags: Cardinal;
7221     dwFourCC: Cardinal;
7222     dwRGBBitCount: Cardinal;
7223     dwRBitMask: Cardinal;
7224     dwGBitMask: Cardinal;
7225     dwBBitMask: Cardinal;
7226     dwABitMask: Cardinal;
7227   end;
7228
7229   TDDSCaps = packed record
7230     dwCaps1: Cardinal;
7231     dwCaps2: Cardinal;
7232     dwDDSX: Cardinal;
7233     dwReserved: Cardinal;
7234   end;
7235
7236   TDDSHeader = packed record
7237     dwSize: Cardinal;
7238     dwFlags: Cardinal;
7239     dwHeight: Cardinal;
7240     dwWidth: Cardinal;
7241     dwPitchOrLinearSize: Cardinal;
7242     dwDepth: Cardinal;
7243     dwMipMapCount: Cardinal;
7244     dwReserved: array[0..10] of Cardinal;
7245     PixelFormat: TDDSPixelFormat;
7246     Caps: TDDSCaps;
7247     dwReserved2: Cardinal;
7248   end;
7249
7250 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7251 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7252 var
7253   Header: TDDSHeader;
7254   Converter: TbmpBitfieldFormat;
7255
7256   function GetDDSFormat: TglBitmapFormat;
7257   var
7258     fd: TFormatDescriptor;
7259     i: Integer;
7260     Range: TglBitmapColorRec;
7261     match: Boolean;
7262   begin
7263     result := tfEmpty;
7264     with Header.PixelFormat do begin
7265       // Compresses
7266       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7267         case Header.PixelFormat.dwFourCC of
7268           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7269           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7270           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7271         end;
7272       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7273
7274         //find matching format
7275         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7276           fd := TFormatDescriptor.Get(result);
7277           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7278              (8 * fd.PixelSize = dwRGBBitCount) then
7279             exit;
7280         end;
7281
7282         //find format with same Range
7283         Range.r := dwRBitMask;
7284         Range.g := dwGBitMask;
7285         Range.b := dwBBitMask;
7286         Range.a := dwABitMask;
7287         for i := 0 to 3 do begin
7288           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7289             Range.arr[i] := Range.arr[i] shr 1;
7290         end;
7291         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7292           fd := TFormatDescriptor.Get(result);
7293           match := true;
7294           for i := 0 to 3 do
7295             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7296               match := false;
7297               break;
7298             end;
7299           if match then
7300             break;
7301         end;
7302
7303         //no format with same range found -> use default
7304         if (result = tfEmpty) then begin
7305           if (dwABitMask > 0) then
7306             result := tfBGRA8
7307           else
7308             result := tfBGR8;
7309         end;
7310
7311         Converter := TbmpBitfieldFormat.Create;
7312         Converter.RedMask   := dwRBitMask;
7313         Converter.GreenMask := dwGBitMask;
7314         Converter.BlueMask  := dwBBitMask;
7315         Converter.AlphaMask := dwABitMask;
7316         Converter.PixelSize := dwRGBBitCount / 8;
7317       end;
7318     end;
7319   end;
7320
7321 var
7322   StreamPos: Int64;
7323   x, y, j, LineSize, RowSize, Magic: Cardinal;
7324   NewImage, TmpData, RowData, SrcData: PByte;
7325   SourceMD, DestMD: Pointer;
7326   Pixel: TglBitmapPixelData;
7327   ddsFormat: TglBitmapFormat;
7328   FormatDesc: TFormatDescriptor;
7329
7330 begin
7331   result    := false;
7332   Converter := nil;
7333   StreamPos := aStream.Position;
7334
7335   // Magic
7336   aStream.Read(Magic, sizeof(Magic));
7337   if (Magic <> DDS_MAGIC) then begin
7338     aStream.Position := StreamPos;
7339     exit;
7340   end;
7341
7342   //Header
7343   aStream.Read(Header, sizeof(Header));
7344   if (Header.dwSize <> SizeOf(Header)) or
7345      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7346         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7347   begin
7348     aStream.Position := StreamPos;
7349     exit;
7350   end;
7351
7352   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7353     raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
7354
7355   ddsFormat := GetDDSFormat;
7356   try
7357     if (ddsFormat = tfEmpty) then
7358       raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7359
7360     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7361     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7362     GetMem(NewImage, Header.dwHeight * LineSize);
7363     try
7364       TmpData := NewImage;
7365
7366       //Converter needed
7367       if Assigned(Converter) then begin
7368         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7369         GetMem(RowData, RowSize);
7370         SourceMD := Converter.CreateMappingData;
7371         DestMD   := FormatDesc.CreateMappingData;
7372         try
7373           for y := 0 to Header.dwHeight-1 do begin
7374             TmpData := NewImage + y * LineSize;
7375             SrcData := RowData;
7376             aStream.Read(SrcData^, RowSize);
7377             for x := 0 to Header.dwWidth-1 do begin
7378               Converter.Unmap(SrcData, Pixel, SourceMD);
7379               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7380               FormatDesc.Map(Pixel, TmpData, DestMD);
7381             end;
7382           end;
7383         finally
7384           Converter.FreeMappingData(SourceMD);
7385           FormatDesc.FreeMappingData(DestMD);
7386           FreeMem(RowData);
7387         end;
7388       end else
7389
7390       // Compressed
7391       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7392         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7393         for Y := 0 to Header.dwHeight-1 do begin
7394           aStream.Read(TmpData^, RowSize);
7395           Inc(TmpData, LineSize);
7396         end;
7397       end else
7398
7399       // Uncompressed
7400       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7401         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7402         for Y := 0 to Header.dwHeight-1 do begin
7403           aStream.Read(TmpData^, RowSize);
7404           Inc(TmpData, LineSize);
7405         end;
7406       end else
7407         raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7408
7409       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
7410       result := true;
7411     except
7412       FreeMem(NewImage);
7413       raise;
7414     end;
7415   finally
7416     FreeAndNil(Converter);
7417   end;
7418 end;
7419
7420 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7421 procedure TglBitmap.SaveDDS(const aStream: TStream);
7422 var
7423   Header: TDDSHeader;
7424   FormatDesc: TFormatDescriptor;
7425 begin
7426   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7427     raise EglBitmapUnsupportedFormatFormat.Create('SaveDDS - ' + UNSUPPORTED_FORMAT);
7428
7429   FormatDesc := TFormatDescriptor.Get(Format);
7430
7431   // Generell
7432   FillChar(Header, SizeOf(Header), 0);
7433   Header.dwSize  := SizeOf(Header);
7434   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7435
7436   Header.dwWidth  := Max(1, Width);
7437   Header.dwHeight := Max(1, Height);
7438
7439   // Caps
7440   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7441
7442   // Pixelformat
7443   Header.PixelFormat.dwSize := sizeof(Header);
7444   if (FormatDesc.IsCompressed) then begin
7445     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7446     case Format of
7447       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7448       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7449       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7450     end;
7451   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7452     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7453     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7454     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7455   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7456     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7457     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7458     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7459     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7460   end else begin
7461     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7462     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7463     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7464     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7465     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7466     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7467   end;
7468
7469   if (FormatDesc.HasAlpha) then
7470     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7471
7472   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7473   aStream.Write(Header, SizeOf(Header));
7474   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7475 end;
7476
7477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7478 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7479 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7480 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7481 begin
7482   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7483     result := fLines[aIndex]
7484   else
7485     result := nil;
7486 end;
7487
7488 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7489 procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
7490   const aWidth: Integer; const aHeight: Integer);
7491 var
7492   Idx, LineWidth: Integer;
7493 begin
7494   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7495
7496   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7497     (* TODO PixelFuncs
7498     fGetPixelFunc := GetPixel2DUnmap;
7499     fSetPixelFunc := SetPixel2DUnmap;
7500     *)
7501     // Assigning Data
7502     if Assigned(Data) then begin
7503       SetLength(fLines, GetHeight);
7504       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7505
7506       for Idx := 0 to GetHeight -1 do begin
7507         fLines[Idx] := Data;
7508         Inc(fLines[Idx], Idx * LineWidth);
7509       end;
7510     end
7511       else SetLength(fLines, 0);
7512   end else begin
7513     SetLength(fLines, 0);
7514     (*
7515     fSetPixelFunc := nil;
7516
7517     case Format of
7518       ifDXT1:
7519         fGetPixelFunc := GetPixel2DDXT1;
7520       ifDXT3:
7521         fGetPixelFunc := GetPixel2DDXT3;
7522       ifDXT5:
7523         fGetPixelFunc := GetPixel2DDXT5;
7524       else
7525         fGetPixelFunc := nil;
7526     end;
7527     *)
7528   end;
7529 end;
7530
7531 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7532 procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
7533 var
7534   FormatDesc: TFormatDescriptor;
7535 begin
7536   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7537
7538   FormatDesc := TFormatDescriptor.Get(Format);
7539   if FormatDesc.IsCompressed then begin
7540     glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7541   end else if aBuildWithGlu then begin
7542     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7543       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7544   end else begin
7545     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7546       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7547   end;
7548
7549   // Freigeben
7550   if (FreeDataAfterGenTexture) then
7551     FreeData;
7552 end;
7553
7554 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7555 procedure TglBitmap2D.AfterConstruction;
7556 begin
7557   inherited;
7558   Target := GL_TEXTURE_2D;
7559 end;
7560
7561 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7562 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7563 var
7564   Temp: pByte;
7565   Size, w, h: Integer;
7566   FormatDesc: TFormatDescriptor;
7567 begin
7568   FormatDesc := TFormatDescriptor.Get(Format);
7569   if FormatDesc.IsCompressed then
7570     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_FORMAT);
7571
7572   w    := aRight  - aLeft;
7573   h    := aBottom - aTop;
7574   Size := FormatDesc.GetSize(w, h);
7575   GetMem(Temp, Size);
7576   try
7577     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7578     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7579     SetDataPointer(Temp, Format, w, h);
7580     FlipVert;
7581   except
7582     FreeMem(Temp);
7583     raise;
7584   end;
7585 end;
7586
7587 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7588 procedure TglBitmap2D.GetDataFromTexture;
7589 var
7590   Temp: PByte;
7591   TempWidth, TempHeight: Integer;
7592   TempType, TempIntFormat: Cardinal;
7593   IntFormat, f: TglBitmapFormat;
7594   FormatDesc: TFormatDescriptor;
7595 begin
7596   Bind;
7597
7598   // Request Data
7599   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7600   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7601   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7602
7603   IntFormat := tfEmpty;
7604   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do
7605     if (TFormatDescriptor.Get(f).glInternalFormat = TempIntFormat) then begin
7606       IntFormat := FormatDesc.Format;
7607       break;
7608     end;
7609
7610   // Getting data from OpenGL
7611   FormatDesc := TFormatDescriptor.Get(IntFormat);
7612   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7613   try
7614     if FormatDesc.IsCompressed then
7615       glGetCompressedTexImage(Target, 0, Temp)
7616     else
7617      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7618     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
7619   except
7620     FreeMem(Temp);
7621     raise;
7622   end;
7623 end;
7624
7625 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7626 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7627 var
7628   BuildWithGlu, PotTex, TexRec: Boolean;
7629   TexSize: Integer;
7630 begin
7631   if Assigned(Data) then begin
7632     // Check Texture Size
7633     if (aTestTextureSize) then begin
7634       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7635
7636       if ((Height > TexSize) or (Width > TexSize)) then
7637         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7638
7639       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7640       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
7641
7642       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7643         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7644     end;
7645
7646     CreateId;
7647     SetupParameters(BuildWithGlu);
7648     UploadData(Target, BuildWithGlu);
7649     glAreTexturesResident(1, @fID, @fIsResident);
7650   end;
7651 end;
7652
7653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7654 function TglBitmap2D.FlipHorz: Boolean;
7655 var
7656   Col, Row: Integer;
7657   TempDestData, DestData, SourceData: PByte;
7658   ImgSize: Integer;
7659 begin
7660   result := inherited FlipHorz;
7661   if Assigned(Data) then begin
7662     SourceData := Data;
7663     ImgSize := Height * fRowSize;
7664     GetMem(DestData, ImgSize);
7665     try
7666       TempDestData := DestData;
7667       Dec(TempDestData, fRowSize + fPixelSize);
7668       for Row := 0 to Height -1 do begin
7669         Inc(TempDestData, fRowSize * 2);
7670         for Col := 0 to Width -1 do begin
7671           Move(SourceData^, TempDestData^, fPixelSize);
7672           Inc(SourceData, fPixelSize);
7673           Dec(TempDestData, fPixelSize);
7674         end;
7675       end;
7676       SetDataPointer(DestData, Format);
7677       result := true;
7678     except
7679       FreeMem(DestData);
7680       raise;
7681     end;
7682   end;
7683 end;
7684
7685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7686 function TglBitmap2D.FlipVert: Boolean;
7687 var
7688   Row: Integer;
7689   TempDestData, DestData, SourceData: PByte;
7690 begin
7691   result := inherited FlipVert;
7692   if Assigned(Data) then begin
7693     SourceData := Data;
7694     GetMem(DestData, Height * fRowSize);
7695     try
7696       TempDestData := DestData;
7697       Inc(TempDestData, Width * (Height -1) * fPixelSize);
7698       for Row := 0 to Height -1 do begin
7699         Move(SourceData^, TempDestData^, fRowSize);
7700         Dec(TempDestData, fRowSize);
7701         Inc(SourceData, fRowSize);
7702       end;
7703       SetDataPointer(DestData, Format);
7704       result := true;
7705     except
7706       FreeMem(DestData);
7707       raise;
7708     end;
7709   end;
7710 end;
7711
7712 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7713 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7715 type
7716   TMatrixItem = record
7717     X, Y: Integer;
7718     W: Single;
7719   end;
7720
7721   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7722   TglBitmapToNormalMapRec = Record
7723     Scale: Single;
7724     Heights: array of Single;
7725     MatrixU : array of TMatrixItem;
7726     MatrixV : array of TMatrixItem;
7727   end;
7728
7729 const
7730   ONE_OVER_255 = 1 / 255;
7731
7732   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7733 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7734 var
7735   Val: Single;
7736 begin
7737   with FuncRec do begin
7738     Val :=
7739       Source.Data.r * LUMINANCE_WEIGHT_R +
7740       Source.Data.g * LUMINANCE_WEIGHT_G +
7741       Source.Data.b * LUMINANCE_WEIGHT_B;
7742     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7743   end;
7744 end;
7745
7746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7747 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7748 begin
7749   with FuncRec do
7750     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7751 end;
7752
7753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7754 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7755 type
7756   TVec = Array[0..2] of Single;
7757 var
7758   Idx: Integer;
7759   du, dv: Double;
7760   Len: Single;
7761   Vec: TVec;
7762
7763   function GetHeight(X, Y: Integer): Single;
7764   begin
7765     with FuncRec do begin
7766       X := Max(0, Min(Size.X -1, X));
7767       Y := Max(0, Min(Size.Y -1, Y));
7768       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7769     end;
7770   end;
7771
7772 begin
7773   with FuncRec do begin
7774     with PglBitmapToNormalMapRec(Args)^ do begin
7775       du := 0;
7776       for Idx := Low(MatrixU) to High(MatrixU) do
7777         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7778
7779       dv := 0;
7780       for Idx := Low(MatrixU) to High(MatrixU) do
7781         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7782
7783       Vec[0] := -du * Scale;
7784       Vec[1] := -dv * Scale;
7785       Vec[2] := 1;
7786     end;
7787
7788     // Normalize
7789     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7790     if Len <> 0 then begin
7791       Vec[0] := Vec[0] * Len;
7792       Vec[1] := Vec[1] * Len;
7793       Vec[2] := Vec[2] * Len;
7794     end;
7795
7796     // Farbe zuweisem
7797     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7798     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7799     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7800   end;
7801 end;
7802
7803 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7804 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7805 var
7806   Rec: TglBitmapToNormalMapRec;
7807
7808   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7809   begin
7810     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7811       Matrix[Index].X := X;
7812       Matrix[Index].Y := Y;
7813       Matrix[Index].W := W;
7814     end;
7815   end;
7816
7817 begin
7818   (* TODO Compression
7819   if not FormatIsUncompressed(InternalFormat) then
7820     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT);
7821     *)
7822
7823   if aScale > 100 then
7824     Rec.Scale := 100
7825   else if aScale < -100 then
7826     Rec.Scale := -100
7827   else
7828     Rec.Scale := aScale;
7829
7830   SetLength(Rec.Heights, Width * Height);
7831   try
7832     case aFunc of
7833       nm4Samples: begin
7834         SetLength(Rec.MatrixU, 2);
7835         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7836         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7837
7838         SetLength(Rec.MatrixV, 2);
7839         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7840         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7841       end;
7842
7843       nmSobel: begin
7844         SetLength(Rec.MatrixU, 6);
7845         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7846         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7847         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7848         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7849         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7850         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7851
7852         SetLength(Rec.MatrixV, 6);
7853         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7854         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7855         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7856         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7857         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7858         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7859       end;
7860
7861       nm3x3: begin
7862         SetLength(Rec.MatrixU, 6);
7863         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7864         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7865         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7866         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7867         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7868         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7869
7870         SetLength(Rec.MatrixV, 6);
7871         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7872         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7873         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7874         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7875         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7876         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7877       end;
7878
7879       nm5x5: begin
7880         SetLength(Rec.MatrixU, 20);
7881         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7882         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7883         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7884         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7885         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7886         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7887         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7888         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7889         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7890         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7891         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7892         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7893         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7894         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7895         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7896         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7897         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7898         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7899         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7900         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7901
7902         SetLength(Rec.MatrixV, 20);
7903         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7904         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7905         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7906         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7907         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7908         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7909         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7910         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7911         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7912         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7913         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7914         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7915         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7916         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7917         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7918         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7919         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7920         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7921         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7922         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7923       end;
7924     end;
7925
7926     // Daten Sammeln
7927     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7928       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, PtrInt(@Rec))
7929     else
7930       AddFunc(glBitmapToNormalMapPrepareFunc, false, PtrInt(@Rec));
7931     AddFunc(glBitmapToNormalMapFunc, false, PtrInt(@Rec));
7932   finally
7933     SetLength(Rec.Heights, 0);
7934   end;
7935 end;
7936
7937
7938
7939
7940
7941
7942
7943
7944
7945 (*
7946 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
7947 var
7948   pTemp: pByte;
7949   Size: Integer;
7950 begin
7951   if Height > 1 then begin
7952     // extract first line of the data
7953     Size := FormatGetImageSize(glBitmapPosition(Width), Format);
7954     GetMem(pTemp, Size);
7955
7956     Move(Data^, pTemp^, Size);
7957
7958     FreeMem(Data);
7959   end else
7960     pTemp := Data;
7961
7962   // set data pointer
7963   inherited SetDataPointer(pTemp, Format, Width);
7964
7965   if FormatIsUncompressed(Format) then begin
7966     fUnmapFunc := FormatGetUnMapFunc(Format);
7967     fGetPixelFunc := GetPixel1DUnmap;
7968   end;
7969 end;
7970
7971
7972 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
7973 var
7974   pTemp: pByte;
7975 begin
7976   pTemp := Data;
7977   Inc(pTemp, Pos.X * fPixelSize);
7978
7979   fUnmapFunc(pTemp, Pixel);
7980 end;
7981
7982
7983 function TglBitmap1D.FlipHorz: Boolean;
7984 var
7985   Col: Integer;
7986   pTempDest, pDest, pSource: pByte;
7987 begin
7988   result := inherited FlipHorz;
7989
7990   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
7991     pSource := Data;
7992
7993     GetMem(pDest, fRowSize);
7994     try
7995       pTempDest := pDest;
7996
7997       Inc(pTempDest, fRowSize);
7998       for Col := 0 to Width -1 do begin
7999         Move(pSource^, pTempDest^, fPixelSize);
8000
8001         Inc(pSource, fPixelSize);
8002         Dec(pTempDest, fPixelSize);
8003       end;
8004
8005       SetDataPointer(pDest, InternalFormat);
8006
8007       result := true;
8008     finally
8009       FreeMem(pDest);
8010     end;
8011   end;
8012 end;
8013
8014
8015 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
8016 begin
8017   // Upload data
8018   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
8019     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
8020   else
8021
8022   // Upload data
8023   if BuildWithGlu then
8024     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
8025   else
8026     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
8027
8028   // Freigeben
8029   if (FreeDataAfterGenTexture) then
8030     FreeData;
8031 end;
8032
8033
8034 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
8035 var
8036   BuildWithGlu, TexRec: Boolean;
8037   glFormat, glInternalFormat, glType: Cardinal;
8038   TexSize: Integer;
8039 begin
8040   if Assigned(Data) then begin
8041     // Check Texture Size
8042     if (TestTextureSize) then begin
8043       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8044
8045       if (Width > TexSize) then
8046         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8047
8048       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8049                 (Target = GL_TEXTURE_RECTANGLE_ARB);
8050
8051       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8052         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8053     end;
8054
8055     CreateId;
8056
8057     SetupParameters(BuildWithGlu);
8058     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8059
8060     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
8061
8062     // Infos sammeln
8063     glAreTexturesResident(1, @fID, @fIsResident);
8064   end;
8065 end;
8066
8067
8068 procedure TglBitmap1D.AfterConstruction;
8069 begin
8070   inherited;
8071
8072   Target := GL_TEXTURE_1D;
8073 end;
8074
8075
8076 { TglBitmapCubeMap }
8077
8078 procedure TglBitmapCubeMap.AfterConstruction;
8079 begin
8080   inherited;
8081
8082   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8083     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8084
8085   SetWrap; // set all to GL_CLAMP_TO_EDGE
8086   Target := GL_TEXTURE_CUBE_MAP;
8087   fGenMode := GL_REFLECTION_MAP;
8088 end;
8089
8090
8091 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
8092 begin
8093   inherited Bind (EnableTextureUnit);
8094
8095   if EnableTexCoordsGen then begin
8096     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8097     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8098     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8099     glEnable(GL_TEXTURE_GEN_S);
8100     glEnable(GL_TEXTURE_GEN_T);
8101     glEnable(GL_TEXTURE_GEN_R);
8102   end;
8103 end;
8104
8105
8106 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
8107 var
8108   glFormat, glInternalFormat, glType: Cardinal;
8109   BuildWithGlu: Boolean;
8110   TexSize: Integer;
8111 begin
8112   // Check Texture Size
8113   if (TestTextureSize) then begin
8114     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8115
8116     if ((Height > TexSize) or (Width > TexSize)) then
8117       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8118
8119     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8120       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8121   end;
8122
8123   // create Texture
8124   if ID = 0 then begin
8125     CreateID;
8126     SetupParameters(BuildWithGlu);
8127   end;
8128
8129   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8130
8131   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
8132 end;
8133
8134
8135 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
8136 begin
8137   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8138 end;
8139
8140
8141 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
8142   DisableTextureUnit: Boolean);
8143 begin
8144   inherited Unbind (DisableTextureUnit);
8145
8146   if DisableTexCoordsGen then begin
8147     glDisable(GL_TEXTURE_GEN_S);
8148     glDisable(GL_TEXTURE_GEN_T);
8149     glDisable(GL_TEXTURE_GEN_R);
8150   end;
8151 end;
8152
8153
8154 { TglBitmapNormalMap }
8155
8156 type
8157   TVec = Array[0..2] of Single;
8158   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8159
8160   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8161   TglBitmapNormalMapRec = record
8162     HalfSize : Integer;
8163     Func: TglBitmapNormalMapGetVectorFunc;
8164   end;
8165
8166
8167 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8168 begin
8169   Vec[0] := HalfSize;
8170   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8171   Vec[2] := - (Position.X + 0.5 - HalfSize);
8172 end;
8173
8174
8175 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8176 begin
8177   Vec[0] := - HalfSize;
8178   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8179   Vec[2] := Position.X + 0.5 - HalfSize;
8180 end;
8181
8182
8183 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8184 begin
8185   Vec[0] := Position.X + 0.5 - HalfSize;
8186   Vec[1] := HalfSize;
8187   Vec[2] := Position.Y + 0.5 - HalfSize;
8188 end;
8189
8190
8191 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8192 begin
8193   Vec[0] := Position.X + 0.5 - HalfSize;
8194   Vec[1] := - HalfSize;
8195   Vec[2] := - (Position.Y + 0.5 - HalfSize);
8196 end;
8197
8198
8199 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8200 begin
8201   Vec[0] := Position.X + 0.5 - HalfSize;
8202   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8203   Vec[2] := HalfSize;
8204 end;
8205
8206
8207 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8208 begin
8209   Vec[0] := - (Position.X + 0.5 - HalfSize);
8210   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8211   Vec[2] := - HalfSize;
8212 end;
8213
8214
8215 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8216 var
8217   Vec : TVec;
8218   Len: Single;
8219 begin
8220   with FuncRec do begin
8221     with PglBitmapNormalMapRec (CustomData)^ do begin
8222       Func(Vec, Position, HalfSize);
8223
8224       // Normalize
8225       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8226       if Len <> 0 then begin
8227         Vec[0] := Vec[0] * Len;
8228         Vec[1] := Vec[1] * Len;
8229         Vec[2] := Vec[2] * Len;
8230       end;
8231
8232       // Scale Vector and AddVectro
8233       Vec[0] := Vec[0] * 0.5 + 0.5;
8234       Vec[1] := Vec[1] * 0.5 + 0.5;
8235       Vec[2] := Vec[2] * 0.5 + 0.5;
8236     end;
8237
8238     // Set Color
8239     Dest.Red   := Round(Vec[0] * 255);
8240     Dest.Green := Round(Vec[1] * 255);
8241     Dest.Blue  := Round(Vec[2] * 255);
8242   end;
8243 end;
8244
8245
8246 procedure TglBitmapNormalMap.AfterConstruction;
8247 begin
8248   inherited;
8249
8250   fGenMode := GL_NORMAL_MAP;
8251 end;
8252
8253
8254 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
8255   TestTextureSize: Boolean);
8256 var
8257   Rec: TglBitmapNormalMapRec;
8258   SizeRec: TglBitmapPixelPosition;
8259 begin
8260   Rec.HalfSize := Size div 2;
8261
8262   FreeDataAfterGenTexture := false;
8263
8264   SizeRec.Fields := [ffX, ffY];
8265   SizeRec.X := Size;
8266   SizeRec.Y := Size;
8267
8268   // Positive X
8269   Rec.Func := glBitmapNormalMapPosX;
8270   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8271   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
8272
8273   // Negative X
8274   Rec.Func := glBitmapNormalMapNegX;
8275   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8276   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
8277
8278   // Positive Y
8279   Rec.Func := glBitmapNormalMapPosY;
8280   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8281   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
8282
8283   // Negative Y
8284   Rec.Func := glBitmapNormalMapNegY;
8285   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8286   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
8287
8288   // Positive Z
8289   Rec.Func := glBitmapNormalMapPosZ;
8290   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8291   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
8292
8293   // Negative Z
8294   Rec.Func := glBitmapNormalMapNegZ;
8295   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8296   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
8297 end;
8298 *)
8299
8300 initialization
8301   glBitmapSetDefaultFormat(tfEmpty);
8302   glBitmapSetDefaultMipmap(mmMipmap);
8303   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8304   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8305
8306   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8307   glBitmapSetDefaultDeleteTextureOnFree    (true);
8308
8309   TFormatDescriptor.Init;
8310
8311 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8312   OpenGLInitialized := false;
8313   InitOpenGLCS := TCriticalSection.Create;
8314 {$ENDIF}
8315
8316 finalization
8317   TFormatDescriptor.Finalize;
8318
8319 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8320   FreeAndNil(InitOpenGLCS);
8321 {$ENDIF}
8322
8323 end.
8324