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 modified by Delphi OpenGL Community (http://delphigl.com/)
   6
   7
   8 ------------------------------------------------------------
   9 The contents of this file are used with permission, subject to
  10 the Mozilla Public License Version 1.1 (the "License"); you may
  11 not use this file except in compliance with the License. You may
  12 obtain a copy of the License at
  13 http://www.mozilla.org/MPL/MPL-1.1.html
  14 ------------------------------------------------------------
  15 Version 2.0.3
  16 ------------------------------------------------------------
  17 History
  18 21-03-2010
  19 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  20   then it's your problem if that isn't true. This prevents the unit for incompatibility
  21   with newer versions of Delphi.
  22 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  23 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  24 10-08-2008
  25 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  26 - Additional Datapointer for functioninterface now has the name CustomData
  27 24-07-2008
  28 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  29 - If you load an texture from an file the property Filename will be set to the name of the file
  30 - Three new properties to attach custom data to the Texture objects
  31   - CustomName  (free for use string)
  32   - CustomNameW (free for use widestring)
  33   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  34 27-05-2008
  35 - RLE TGAs loaded much faster
  36 26-05-2008
  37 - fixed some problem with reading RLE TGAs.
  38 21-05-2008
  39 - function clone now only copys data if it's assigned and now it also copies the ID
  40 - it seems that lazarus dont like comments in comments.
  41 01-05-2008
  42 - It's possible to set the id of the texture
  43 - define GLB_NO_NATIVE_GL deactivated by default
  44 27-04-2008
  45 - Now supports the following libraries
  46   - SDL and SDL_image
  47   - libPNG
  48   - libJPEG
  49 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  50 - BMPs now loaded manuel
  51 - Large restructuring
  52 - Property DataPtr now has the name Data
  53 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  54 - Unused Depth removed
  55 - Function FreeData to freeing image data added
  56 24-10-2007
  57 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  58 15-11-2006
  59 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  60 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  61 - Function ReadOpenGLExtension is now only intern
  62 29-06-2006
  63 - pngimage now disabled by default like all other versions.
  64 26-06-2006
  65 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  66 22-06-2006
  67 - Fixed some Problem with Delphi 5
  68 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  69 22-03-2006
  70 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  71 09-03-2006
  72 - Internal Format ifDepth8 added
  73 - function GrabScreen now supports all uncompressed formats
  74 31-01-2006
  75 - AddAlphaFromglBitmap implemented
  76 29-12-2005
  77 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  78 28-12-2005
  79 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  80   property Width, Height, Depth are still existing and new property Dimension are avail
  81 11-12-2005
  82 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  83 19-10-2005
  84 - Added function GrabScreen to class TglBitmap2D
  85 18-10-2005
  86 - Added support to Save images
  87 - Added function Clone to Clone Instance
  88 11-10-2005
  89 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  90   Usefull for Future
  91 - Several speed optimizations
  92 09-10-2005
  93 - Internal structure change. Loading of TGA, PNG and DDS improved.
  94   Data, format and size will now set directly with SetDataPtr.
  95 - AddFunc now works with all Types of Images and Formats
  96 - Some Funtions moved to Baseclass TglBitmap
  97 06-10-2005
  98 - Added Support to decompress DXT3 and DXT5 compressed Images.
  99 - Added Mapping to convert data from one format into an other.
 100 05-10-2005
 101 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 102   supported Input format (supported by GetPixel) into any uncompresed Format
 103 - Added Support to decompress DXT1 compressed Images.
 104 - SwapColors replaced by ConvertTo
 105 04-10-2005
 106 - Added Support for compressed DDSs
 107 - Added new internal formats (DXT1, DXT3, DXT5)
 108 29-09-2005
 109 - Parameter Components renamed to InternalFormat
 110 23-09-2005
 111 - Some AllocMem replaced with GetMem (little speed change)
 112 - better exception handling. Better protection from memory leaks.
 113 22-09-2005
 114 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 115 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 116 07-09-2005
 117 - Added support for Grayscale textures
 118 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 119 10-07-2005
 120 - Added support for GL_VERSION_2_0
 121 - Added support for GL_EXT_texture_filter_anisotropic
 122 04-07-2005
 123 - Function FillWithColor fills the Image with one Color
 124 - Function LoadNormalMap added
 125 30-06-2005
 126 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 127 - ToNormalMap now supports Sobel (nmSobel) function.
 128 29-06-2005
 129 - support for RLE Compressed RGB TGAs added
 130 28-06-2005
 131 - Class TglBitmapNormalMap added to support Normalmap generation
 132 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 133   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 134 16-06-2005
 135 - Method LoadCubeMapClass removed
 136 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 137 - virtual abstract method GenTexture in class TglBitmap now is protected
 138 12-06-2005
 139 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 140 10-06-2005
 141 - little enhancement for IsPowerOfTwo
 142 - TglBitmap1D.GenTexture now tests NPOT Textures
 143 06-06-2005
 144 - some little name changes. All properties or function with Texture in name are
 145   now without texture in name. We have allways texture so we dosn't name it.
 146 03-06-2005
 147 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 148   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 149 02-06-2005
 150 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 151 25-04-2005
 152 - Function Unbind added
 153 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 154 21-04-2005
 155 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 156 29-03-2005
 157 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 158   To Enable png's use the define pngimage
 159 22-03-2005
 160 - New Functioninterface added
 161 - Function GetPixel added
 162 27-11-2004
 163 - Property BuildMipMaps renamed to MipMap
 164 21-11-2004
 165 - property Name removed.
 166 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 167 22-05-2004
 168 - property name added. Only used in glForms!
 169 26-11-2003
 170 - property FreeDataAfterGenTexture is now available as default (default = true)
 171 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 172 - function MoveMemory replaced with function Move (little speed change)
 173 - several calculations stored in variables (little speed change)
 174 29-09-2003
 175 - property BuildMipsMaps added (default = true)
 176   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 177 - property FreeDataAfterGenTexture added (default = true)
 178   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 179 - parameter DisableOtherTextureUnits of Bind removed
 180 - parameter FreeDataAfterGeneration of GenTextures removed
 181 12-09-2003
 182 - TglBitmap dosn't delete data if class was destroyed (fixed)
 183 09-09-2003
 184 - Bind now enables TextureUnits (by params)
 185 - GenTextures can leave data (by param)
 186 - LoadTextures now optimal
 187 03-09-2003
 188 - Performance optimization in AddFunc
 189 - procedure Bind moved to subclasses
 190 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 191 19-08-2003
 192 - Texturefilter and texturewrap now also as defaults
 193   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 194   Magfilter = GL_LINEAR
 195   Wrap(str) = GL_CLAMP_TO_EDGE
 196 - Added new format tfCompressed to create a compressed texture.
 197 - propertys IsCompressed, TextureSize and IsResident added
 198   IsCompressed and TextureSize only contains data from level 0
 199 18-08-2003
 200 - Added function AddFunc to add PerPixelEffects to Image
 201 - LoadFromFunc now based on AddFunc
 202 - Invert now based on AddFunc
 203 - SwapColors now based on AddFunc
 204 16-08-2003
 205 - Added function FlipHorz
 206 15-08-2003
 207 - Added function LaodFromFunc to create images with function
 208 - Added function FlipVert
 209 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 210 29-07-2003
 211 - Added Alphafunctions to calculate alpha per function
 212 - Added Alpha from ColorKey using alphafunctions
 213 28-07-2003
 214 - First full functionally Version of glBitmap
 215 - Support for 24Bit and 32Bit TGA Pictures added
 216 25-07-2003
 217 - begin of programming
 218 ***********************************************************}
 219 unit glBitmap;
 220
 221 // Please uncomment the defines below to configure the glBitmap to your preferences.
 222 // If you have configured the unit you can uncomment the warning above.
 223 {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 224
 225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 226 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 228 // activate to enable build-in OpenGL support with statically linked methods
 229 // use dglOpenGL.pas if not enabled
 230 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 231
 232 // activate to enable build-in OpenGL support with dynamically linked methods
 233 // use dglOpenGL.pas if not enabled
 234 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 235
 236
 237 // activate to enable the support for SDL_surfaces
 238 {.$DEFINE GLB_SDL}
 239
 240 // activate  to enable the support for TBitmap from Delphi (not lazarus)
 241 {.$DEFINE GLB_DELPHI}
 242
 243 // activate to enable the support for TLazIntfImage from Lazarus
 244 {$DEFINE GLB_LAZARUS}
 245
 246
 247 // activate to enable the support of SDL_image to load files. (READ ONLY)
 248 // If you enable SDL_image all other libraries will be ignored!
 249 {.$DEFINE GLB_SDL_IMAGE}
 250
 251
 252
 253 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
 254 // if you enable pngimage the libPNG will be ignored
 255 {.$DEFINE GLB_PNGIMAGE}
 256
 257 // activate to use the libPNG -> http://www.libpng.org/
 258 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
 259 {.$DEFINE GLB_LIB_PNG}
 260
 261
 262
 263 // if you enable delphi jpegs the libJPEG will be ignored
 264 {.$DEFINE GLB_DELPHI_JPEG}
 265
 266 // activate to use the libJPEG -> http://www.ijg.org/
 267 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
 268 {.$DEFINE GLB_LIB_JPEG}
 269
 270
 271 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 272 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 274 // Delphi Versions
 275 {$IFDEF fpc}
 276   {$MODE Delphi}
 277
 278   {$IFDEF CPUI386}
 279     {$DEFINE CPU386}
 280     {$ASMMODE INTEL}
 281   {$ENDIF}
 282
 283   {$IFNDEF WINDOWS}
 284     {$linklib c}
 285   {$ENDIF}
 286 {$ENDIF}
 287
 288 // Operation System
 289 {$IF DEFINED(WIN32) or DEFINED(WIN64)}
 290   {$DEFINE GLB_WIN}
 291 {$ELSEIF DEFINED(LINUX)}
 292   {$DEFINE GLB_LINUX}
 293 {$ENDIF}
 294
 295 // native OpenGL Support
 296 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 297   {$DEFINE GLB_NATIVE_OGL}
 298 {$ENDIF}
 299
 300 // checking define combinations
 301 //SDL Image
 302 {$IFDEF GLB_SDL_IMAGE}
 303   {$IFNDEF GLB_SDL}
 304     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 305     {$DEFINE GLB_SDL}
 306   {$ENDIF}
 307   {$IFDEF GLB_PNGIMAGE}
 308     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 309     {$undef GLB_PNGIMAGE}
 310   {$ENDIF}
 311   {$IFDEF GLB_DELPHI_JPEG}
 312     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 313     {$undef GLB_DELPHI_JPEG}
 314   {$ENDIF}
 315   {$IFDEF GLB_LIB_PNG}
 316     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 317     {$undef GLB_LIB_PNG}
 318   {$ENDIF}
 319   {$IFDEF GLB_LIB_JPEG}
 320     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 321     {$undef GLB_LIB_JPEG}
 322   {$ENDIF}
 323
 324   {$DEFINE GLB_SUPPORT_PNG_READ}
 325   {$DEFINE GLB_SUPPORT_JPEG_READ}
 326 {$ENDIF}
 327
 328 // PNG Image
 329 {$IFDEF GLB_PNGIMAGE}
 330   {$IFDEF GLB_LIB_PNG}
 331     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 332     {$undef GLB_LIB_PNG}
 333   {$ENDIF}
 334
 335   {$DEFINE GLB_SUPPORT_PNG_READ}
 336   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 337 {$ENDIF}
 338
 339 // libPNG
 340 {$IFDEF GLB_LIB_PNG}
 341   {$DEFINE GLB_SUPPORT_PNG_READ}
 342   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 343 {$ENDIF}
 344
 345 // JPEG Image
 346 {$IFDEF GLB_DELPHI_JPEG}
 347   {$IFDEF GLB_LIB_JPEG}
 348     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 349     {$undef GLB_LIB_JPEG}
 350   {$ENDIF}
 351
 352   {$DEFINE GLB_SUPPORT_JPEG_READ}
 353   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 354 {$ENDIF}
 355
 356 // libJPEG
 357 {$IFDEF GLB_LIB_JPEG}
 358   {$DEFINE GLB_SUPPORT_JPEG_READ}
 359   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 360 {$ENDIF}
 361
 362 // native OpenGL
 363 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 364   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 365 {$ENDIF}
 366
 367 // general options
 368 {$EXTENDEDSYNTAX ON}
 369 {$LONGSTRINGS ON}
 370 {$ALIGN ON}
 371 {$IFNDEF FPC}
 372   {$OPTIMIZATION ON}
 373 {$ENDIF}
 374
 375 interface
 376
 377 uses
 378   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,          {$ENDIF}
 379   {$IF DEFINED(GLB_WIN) AND
 380        DEFINED(GLB_NATIVE_OGL)} windows,            {$ENDIF}
 381
 382   {$IFDEF GLB_SDL}              SDL,                {$ENDIF}
 383   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType,       {$ENDIF}
 384   {$IFDEF GLB_DELPHI}           Dialogs, Graphics,  {$ENDIF}
 385
 386   {$IFDEF GLB_SDL_IMAGE}        SDL_image,          {$ENDIF}
 387
 388   {$IFDEF GLB_PNGIMAGE}         pngimage,           {$ENDIF}
 389   {$IFDEF GLB_LIB_PNG}          libPNG,             {$ENDIF}
 390
 391   {$IFDEF GLB_DELPHI_JPEG}      JPEG,               {$ENDIF}
 392   {$IFDEF GLB_LIB_JPEG}         libJPEG,            {$ENDIF}
 393
 394   Classes, SysUtils;
 395
 396 {$IFNDEF GLB_DELPHI}
 397 type
 398   HGLRC = Cardinal;
 399   DWORD = Cardinal;
 400   PDWORD = ^DWORD;
 401
 402   TRGBQuad = packed record
 403     rgbBlue: Byte;
 404     rgbGreen: Byte;
 405     rgbRed: Byte;
 406     rgbReserved: Byte;
 407   end;
 408 {$ENDIF}
 409
 410 {$IFDEF GLB_NATIVE_OGL}
 411 const
 412   GL_TRUE   = 1;
 413   GL_FALSE  = 0;
 414
 415   GL_VERSION    = $1F02;
 416   GL_EXTENSIONS = $1F03;
 417
 418   GL_TEXTURE_1D         = $0DE0;
 419   GL_TEXTURE_2D         = $0DE1;
 420   GL_TEXTURE_RECTANGLE  = $84F5;
 421
 422   GL_TEXTURE_WIDTH            = $1000;
 423   GL_TEXTURE_HEIGHT           = $1001;
 424   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 425
 426   GL_ALPHA    = $1906;
 427   GL_ALPHA4   = $803B;
 428   GL_ALPHA8   = $803C;
 429   GL_ALPHA12  = $803D;
 430   GL_ALPHA16  = $803E;
 431
 432   GL_LUMINANCE    = $1909;
 433   GL_LUMINANCE4   = $803F;
 434   GL_LUMINANCE8   = $8040;
 435   GL_LUMINANCE12  = $8041;
 436   GL_LUMINANCE16  = $8042;
 437
 438   GL_LUMINANCE_ALPHA      = $190A;
 439   GL_LUMINANCE4_ALPHA4    = $8043;
 440   GL_LUMINANCE6_ALPHA2    = $8044;
 441   GL_LUMINANCE8_ALPHA8    = $8045;
 442   GL_LUMINANCE12_ALPHA4   = $8046;
 443   GL_LUMINANCE12_ALPHA12  = $8047;
 444   GL_LUMINANCE16_ALPHA16  = $8048;
 445
 446   GL_RGB      = $1907;
 447   GL_BGR      = $80E0;
 448   GL_R3_G3_B2 = $2A10;
 449   GL_RGB4     = $804F;
 450   GL_RGB5     = $8050;
 451   GL_RGB565   = $8D62;
 452   GL_RGB8     = $8051;
 453   GL_RGB10    = $8052;
 454   GL_RGB12    = $8053;
 455   GL_RGB16    = $8054;
 456
 457   GL_RGBA     = $1908;
 458   GL_BGRA     = $80E1;
 459   GL_RGBA2    = $8055;
 460   GL_RGBA4    = $8056;
 461   GL_RGB5_A1  = $8057;
 462   GL_RGBA8    = $8058;
 463   GL_RGB10_A2 = $8059;
 464   GL_RGBA12   = $805A;
 465   GL_RGBA16   = $805B;
 466
 467   GL_DEPTH_COMPONENT    = $1902;
 468   GL_DEPTH_COMPONENT16  = $81A5;
 469   GL_DEPTH_COMPONENT24  = $81A6;
 470   GL_DEPTH_COMPONENT32  = $81A7;
 471
 472   GL_COMPRESSED_RGB                 = $84ED;
 473   GL_COMPRESSED_RGBA                = $84EE;
 474   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 475   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 476   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 477   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 478
 479   GL_UNSIGNED_BYTE            = $1401;
 480   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 481   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 482
 483   GL_UNSIGNED_SHORT             = $1403;
 484   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 485   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 486   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 487   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 488   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 489   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 490
 491   GL_UNSIGNED_INT                 = $1405;
 492   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 493   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 494   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 495   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 496
 497   { Texture Filter }
 498   GL_TEXTURE_MAG_FILTER     = $2800;
 499   GL_TEXTURE_MIN_FILTER     = $2801;
 500   GL_NEAREST                = $2600;
 501   GL_NEAREST_MIPMAP_NEAREST = $2700;
 502   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 503   GL_LINEAR                 = $2601;
 504   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 505   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 506
 507   { Texture Wrap }
 508   GL_TEXTURE_WRAP_S   = $2802;
 509   GL_TEXTURE_WRAP_T   = $2803;
 510   GL_TEXTURE_WRAP_R   = $8072;
 511   GL_CLAMP            = $2900;
 512   GL_REPEAT           = $2901;
 513   GL_CLAMP_TO_EDGE    = $812F;
 514   GL_CLAMP_TO_BORDER  = $812D;
 515   GL_MIRRORED_REPEAT  = $8370;
 516
 517   { Other }
 518   GL_GENERATE_MIPMAP      = $8191;
 519   GL_TEXTURE_BORDER_COLOR = $1004;
 520   GL_MAX_TEXTURE_SIZE     = $0D33;
 521   GL_PACK_ALIGNMENT       = $0D05;
 522   GL_UNPACK_ALIGNMENT     = $0CF5;
 523
 524   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 525   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 526
 527 {$ifdef LINUX}
 528   libglu    = 'libGLU.so.1';
 529   libopengl = 'libGL.so.1';
 530 {$else}
 531   libglu    = 'glu32.dll';
 532   libopengl = 'opengl32.dll';
 533 {$endif}
 534
 535 type
 536   GLboolean = BYTEBOOL;
 537   GLint     = Integer;
 538   GLsizei   = Integer;
 539   GLuint    = Cardinal;
 540   GLfloat   = Single;
 541   GLenum    = Cardinal;
 542
 543   PGLvoid    = Pointer;
 544   PGLboolean = ^GLboolean;
 545   PGLint     = ^GLint;
 546   PGLuint    = ^GLuint;
 547   PGLfloat   = ^GLfloat;
 548
 549   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 550   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}
 551   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 552
 553 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 554   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 555   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 556
 557   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 558   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 559
 560   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 561   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 562   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 563   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 564   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 565   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 566
 567   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 568   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 569   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 570
 571   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 572   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 573   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 574
 575   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}
 576   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}
 577   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 578
 579   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 580   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 581
 582   {$IFDEF GLB_LINUX}
 583   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 584   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 585   {$ELSE}
 586   TwglGetProcAddress = function(ProcName: PAnsiChar): Pointer; stdcall;
 587   {$ENDIF}
 588
 589 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 590   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 591   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 592
 593   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 594   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 595
 596   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 597   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 598   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 599   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 600   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 601   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 602
 603   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 604   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 605   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 606
 607   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 608   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;
 609   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 610
 611   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;
 612   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;
 613   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 614
 615   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 616   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 617 {$ENDIF}
 618
 619 var
 620   GL_VERSION_1_2,
 621   GL_VERSION_1_3,
 622   GL_VERSION_1_4,
 623   GL_VERSION_2_0,
 624
 625   GL_SGIS_generate_mipmap,
 626
 627   GL_ARB_texture_border_clamp,
 628   GL_ARB_texture_mirrored_repeat,
 629   GL_ARB_texture_rectangle,
 630   GL_ARB_texture_non_power_of_two,
 631
 632   GL_IBM_texture_mirrored_repeat,
 633
 634   GL_NV_texture_rectangle,
 635
 636   GL_EXT_texture_edge_clamp,
 637   GL_EXT_texture_rectangle,
 638   GL_EXT_texture_filter_anisotropic: Boolean;
 639
 640   glCompressedTexImage1D: TglCompressedTexImage1D;
 641   glCompressedTexImage2D: TglCompressedTexImage2D;
 642   glGetCompressedTexImage: TglGetCompressedTexImage;
 643
 644 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 645   glEnable: TglEnable;
 646   glDisable: TglDisable;
 647
 648   glGetString: TglGetString;
 649   glGetIntegerv: TglGetIntegerv;
 650
 651   glTexParameteri: TglTexParameteri;
 652   glTexParameterfv: TglTexParameterfv;
 653   glGetTexParameteriv: TglGetTexParameteriv;
 654   glGetTexParameterfv: TglGetTexParameterfv;
 655   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 656   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 657
 658   glGenTextures: TglGenTextures;
 659   glBindTexture: TglBindTexture;
 660   glDeleteTextures: TglDeleteTextures;
 661
 662   glAreTexturesResident: TglAreTexturesResident;
 663   glReadPixels: TglReadPixels;
 664   glPixelStorei: TglPixelStorei;
 665
 666   glTexImage1D: TglTexImage1D;
 667   glTexImage2D: TglTexImage2D;
 668   glGetTexImage: TglGetTexImage;
 669
 670   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 671   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 672
 673   {$IF DEFINED(GLB_WIN)}
 674   wglGetProcAddress: TwglGetProcAddress;
 675   {$ELSEIF DEFINED(GLB_LINUX)}
 676   glXGetProcAddress: TglXGetProcAddress;
 677   glXGetProcAddressARB: TglXGetProcAddressARB;
 678   {$ENDIF}
 679 {$ENDIF}
 680
 681 (*
 682 {$IFDEF GLB_DELPHI}
 683 var
 684   gLastContext: HGLRC;
 685 {$ENDIF}
 686 *)
 687
 688 {$ENDIF}
 689
 690 type
 691 ////////////////////////////////////////////////////////////////////////////////////////////////////
 692   TglBitmapFormat = (
 693     tfEmpty = 0, //must be smallest value!
 694
 695     tfAlpha4,
 696     tfAlpha8,
 697     tfAlpha12,
 698     tfAlpha16,
 699
 700     tfLuminance4,
 701     tfLuminance8,
 702     tfLuminance12,
 703     tfLuminance16,
 704
 705     tfLuminance4Alpha4,
 706     tfLuminance6Alpha2,
 707     tfLuminance8Alpha8,
 708     tfLuminance12Alpha4,
 709     tfLuminance12Alpha12,
 710     tfLuminance16Alpha16,
 711
 712     tfR3G3B2,
 713     tfRGB4,
 714     tfR5G6B5,
 715     tfRGB5,
 716     tfRGB8,
 717     tfRGB10,
 718     tfRGB12,
 719     tfRGB16,
 720
 721     tfRGBA2,
 722     tfRGBA4,
 723     tfRGB5A1,
 724     tfRGBA8,
 725     tfRGB10A2,
 726     tfRGBA12,
 727     tfRGBA16,
 728
 729     tfBGR4,
 730     tfB5G6R5,
 731     tfBGR5,
 732     tfBGR8,
 733     tfBGR10,
 734     tfBGR12,
 735     tfBGR16,
 736
 737     tfBGRA2,
 738     tfBGRA4,
 739     tfBGR5A1,
 740     tfBGRA8,
 741     tfBGR10A2,
 742     tfBGRA12,
 743     tfBGRA16,
 744
 745     tfDepth16,
 746     tfDepth24,
 747     tfDepth32,
 748
 749     tfS3tcDtx1RGBA,
 750     tfS3tcDtx3RGBA,
 751     tfS3tcDtx5RGBA
 752   );
 753
 754   TglBitmapFileType = (
 755      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 756      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 757      ftDDS,
 758      ftTGA,
 759      ftBMP);
 760    TglBitmapFileTypes = set of TglBitmapFileType;
 761
 762    TglBitmapMipMap = (
 763      mmNone,
 764      mmMipmap,
 765      mmMipmapGlu);
 766
 767    TglBitmapNormalMapFunc = (
 768      nm4Samples,
 769      nmSobel,
 770      nm3x3,
 771      nm5x5);
 772
 773  ////////////////////////////////////////////////////////////////////////////////////////////////////
 774    EglBitmapException               = class(Exception);
 775    EglBitmapSizeToLargeException    = class(EglBitmapException);
 776    EglBitmapNonPowerOfTwoException  = class(EglBitmapException);
 777    EglBitmapUnsupportedFormat       = class(EglBitmapException)
 778      constructor Create(const aFormat: TglBitmapFormat); overload;
 779      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 780    end;
 781
 782 ////////////////////////////////////////////////////////////////////////////////////////////////////
 783   TglBitmapColorRec = packed record
 784   case Integer of
 785     0: (r, g, b, a: Cardinal);
 786     1: (arr: array[0..3] of Cardinal);
 787   end;
 788
 789   TglBitmapPixelData = packed record
 790     Data, Range: TglBitmapColorRec;
 791     Format: TglBitmapFormat;
 792   end;
 793   PglBitmapPixelData = ^TglBitmapPixelData;
 794
 795 ////////////////////////////////////////////////////////////////////////////////////////////////////
 796   TglBitmapPixelPositionFields = set of (ffX, ffY);
 797   TglBitmapPixelPosition = record
 798     Fields : TglBitmapPixelPositionFields;
 799     X : Word;
 800     Y : Word;
 801   end;
 802
 803 ////////////////////////////////////////////////////////////////////////////////////////////////////
 804   TglBitmap = class;
 805   TglBitmapFunctionRec = record
 806     Sender:   TglBitmap;
 807     Size:     TglBitmapPixelPosition;
 808     Position: TglBitmapPixelPosition;
 809     Source:   TglBitmapPixelData;
 810     Dest:     TglBitmapPixelData;
 811     Args:     Pointer;
 812   end;
 813   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 814
 815 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 816   TglBitmap = class
 817   protected
 818     fID: GLuint;
 819     fTarget: GLuint;
 820     fAnisotropic: Integer;
 821     fDeleteTextureOnFree: Boolean;
 822     fFreeDataAfterGenTexture: Boolean;
 823     fData: PByte;
 824     fIsResident: Boolean;
 825     fBorderColor: array[0..3] of Single;
 826
 827     fDimension: TglBitmapPixelPosition;
 828     fMipMap: TglBitmapMipMap;
 829     fFormat: TglBitmapFormat;
 830
 831     // Mapping
 832     fPixelSize: Integer;
 833     fRowSize: Integer;
 834
 835     // Filtering
 836     fFilterMin: Cardinal;
 837     fFilterMag: Cardinal;
 838
 839     // TexturWarp
 840     fWrapS: Cardinal;
 841     fWrapT: Cardinal;
 842     fWrapR: Cardinal;
 843
 844     // CustomData
 845     fFilename: String;
 846     fCustomName: String;
 847     fCustomNameW: WideString;
 848     fCustomData: Pointer;
 849
 850     //Getter
 851     function GetWidth:  Integer; virtual;
 852     function GetHeight: Integer; virtual;
 853
 854     function GetFileWidth:  Integer; virtual;
 855     function GetFileHeight: Integer; virtual;
 856
 857     //Setter
 858     procedure SetCustomData(const aValue: Pointer);
 859     procedure SetCustomName(const aValue: String);
 860     procedure SetCustomNameW(const aValue: WideString);
 861     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 862     procedure SetFormat(const aValue: TglBitmapFormat);
 863     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 864     procedure SetID(const aValue: Cardinal);
 865     procedure SetMipMap(const aValue: TglBitmapMipMap);
 866     procedure SetTarget(const aValue: Cardinal);
 867     procedure SetAnisotropic(const aValue: Integer);
 868
 869     procedure CreateID;
 870     procedure SetupParameters(out aBuildWithGlu: Boolean);
 871     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
 872       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 873     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 874
 875     function FlipHorz: Boolean; virtual;
 876     function FlipVert: Boolean; virtual;
 877
 878     property Width:  Integer read GetWidth;
 879     property Height: Integer read GetHeight;
 880
 881     property FileWidth:  Integer read GetFileWidth;
 882     property FileHeight: Integer read GetFileHeight;
 883   public
 884     //Properties
 885     property ID:           Cardinal        read fID          write SetID;
 886     property Target:       Cardinal        read fTarget      write SetTarget;
 887     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 888     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 889     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 890
 891     property Filename:    String     read fFilename;
 892     property CustomName:  String     read fCustomName  write SetCustomName;
 893     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
 894     property CustomData:  Pointer    read fCustomData  write SetCustomData;
 895
 896     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
 897     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
 898
 899     property Dimension:  TglBitmapPixelPosition  read fDimension;
 900     property Data:       PByte                   read fData;
 901     property IsResident: Boolean                 read fIsResident;
 902
 903     procedure AfterConstruction; override;
 904     procedure BeforeDestruction; override;
 905
 906     procedure PrepareResType(var aResource: String; var aResType: PChar);
 907
 908     //Load
 909     procedure LoadFromFile(const aFilename: String);
 910     procedure LoadFromStream(const aStream: TStream); virtual;
 911     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
 912       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
 913     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
 914     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 915
 916     //Save
 917     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
 918     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 919
 920     //Convert
 921     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 922     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 923       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 924   public
 925     //Alpha & Co
 926     {$IFDEF GLB_SDL}
 927     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 928     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 929     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 930     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
 931       const aArgs: Pointer = nil): Boolean;
 932     {$ENDIF}
 933
 934     {$IFDEF GLB_DELPHI}
 935     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 936     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 937     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 938     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
 939       const aArgs: Pointer = nil): Boolean;
 940     {$ENDIF}
 941
 942     {$IFDEF GLB_LAZARUS}
 943     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 944     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
 945     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 946     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
 947       const aArgs: Pointer = nil): Boolean;
 948     {$ENDIF}
 949
 950     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
 951       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 952     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
 953       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 954
 955     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 956     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 957     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 958     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 959
 960     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 961     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 962     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 963
 964     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 965     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 966     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 967
 968     function RemoveAlpha: Boolean; virtual;
 969   public
 970     //Common
 971     function Clone: TglBitmap;
 972     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 973     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
 974     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
 975     procedure FreeData;
 976
 977     //ColorFill
 978     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 979     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 980     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
 981
 982     //TexParameters
 983     procedure SetFilter(const aMin, aMag: Cardinal);
 984     procedure SetWrap(
 985       const S: Cardinal = GL_CLAMP_TO_EDGE;
 986       const T: Cardinal = GL_CLAMP_TO_EDGE;
 987       const R: Cardinal = GL_CLAMP_TO_EDGE);
 988
 989     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
 990     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
 991
 992     //Constructors
 993     constructor Create; overload;
 994     constructor Create(const aFileName: String); overload;
 995     constructor Create(const aStream: TStream); overload;
 996     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
 997     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
 998     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 999     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1000   private
1001     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1002     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1003
1004     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1005     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1006
1007     function LoadBMP(const aStream: TStream): Boolean; virtual;
1008     procedure SaveBMP(const aStream: TStream); virtual;
1009
1010     function LoadTGA(const aStream: TStream): Boolean; virtual;
1011     procedure SaveTGA(const aStream: TStream); virtual;
1012
1013     function LoadDDS(const aStream: TStream): Boolean; virtual;
1014     procedure SaveDDS(const aStream: TStream); virtual;
1015   end;
1016
1017 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1018   TglBitmap2D = class(TglBitmap)
1019   protected
1020     // Bildeinstellungen
1021     fLines: array of PByte;
1022
1023     function GetScanline(const aIndex: Integer): Pointer;
1024     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
1025       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1026     procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
1027   public
1028     property Width;
1029     property Height;
1030     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1031
1032     procedure AfterConstruction; override;
1033
1034     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1035     procedure GetDataFromTexture;
1036     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1037
1038     function FlipHorz: Boolean; override;
1039     function FlipVert: Boolean; override;
1040
1041     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1042       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1043   end;
1044
1045 (* TODO
1046   TglBitmapCubeMap = class(TglBitmap2D)
1047   protected
1048     fGenMode: Integer;
1049
1050     // Hide GenTexture
1051     procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
1052   public
1053     procedure AfterConstruction; override;
1054
1055     procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
1056
1057     procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
1058     procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
1059   end;
1060
1061
1062   TglBitmapNormalMap = class(TglBitmapCubeMap)
1063   public
1064     procedure AfterConstruction; override;
1065
1066     procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
1067   end;
1068
1069
1070   TglBitmap1D = class(TglBitmap)
1071   protected
1072     procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1073
1074     procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
1075     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
1076   public
1077     // propertys
1078     property Width;
1079
1080     procedure AfterConstruction; override;
1081
1082     // Other
1083     function FlipHorz: Boolean; override;
1084
1085     // Generation
1086     procedure GenTexture(TestTextureSize: Boolean = true); override;
1087   end;
1088 *)
1089
1090 const
1091   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1092
1093 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1094 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1095 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1096 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1097 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1098 procedure glBitmapSetDefaultWrap(
1099   const S: Cardinal = GL_CLAMP_TO_EDGE;
1100   const T: Cardinal = GL_CLAMP_TO_EDGE;
1101   const R: Cardinal = GL_CLAMP_TO_EDGE);
1102
1103 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1104 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1105 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1106 function glBitmapGetDefaultFormat: TglBitmapFormat;
1107 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1108 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1109
1110 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1111 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1112 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1113
1114 var
1115   glBitmapDefaultDeleteTextureOnFree: Boolean;
1116   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1117   glBitmapDefaultFormat: TglBitmapFormat;
1118   glBitmapDefaultMipmap: TglBitmapMipMap;
1119   glBitmapDefaultFilterMin: Cardinal;
1120   glBitmapDefaultFilterMag: Cardinal;
1121   glBitmapDefaultWrapS: Cardinal;
1122   glBitmapDefaultWrapT: Cardinal;
1123   glBitmapDefaultWrapR: Cardinal;
1124
1125 {$IFDEF GLB_DELPHI}
1126 function CreateGrayPalette: HPALETTE;
1127 {$ENDIF}
1128
1129 implementation
1130
1131 uses
1132   Math, syncobjs, typinfo;
1133
1134 type
1135 ////////////////////////////////////////////////////////////////////////////////////////////////////
1136   TShiftRec = packed record
1137   case Integer of
1138     0: (r, g, b, a: Byte);
1139     1: (arr: array[0..3] of Byte);
1140   end;
1141
1142   TFormatDescriptor = class(TObject)
1143   private
1144     function GetRedMask: QWord;
1145     function GetGreenMask: QWord;
1146     function GetBlueMask: QWord;
1147     function GetAlphaMask: QWord;
1148   protected
1149     fFormat: TglBitmapFormat;
1150     fWithAlpha: TglBitmapFormat;
1151     fWithoutAlpha: TglBitmapFormat;
1152     fRGBInverted: TglBitmapFormat;
1153     fUncompressed: TglBitmapFormat;
1154     fPixelSize: Single;
1155     fIsCompressed: Boolean;
1156
1157     fRange: TglBitmapColorRec;
1158     fShift: TShiftRec;
1159
1160     fglFormat:         Cardinal;
1161     fglInternalFormat: Cardinal;
1162     fglDataFormat:     Cardinal;
1163
1164     function GetComponents: Integer; virtual;
1165   public
1166     property Format:       TglBitmapFormat read fFormat;
1167     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1168     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1169     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1170     property Components:   Integer         read GetComponents;
1171     property PixelSize:    Single          read fPixelSize;
1172     property IsCompressed: Boolean         read fIsCompressed;
1173
1174     property glFormat:         Cardinal read fglFormat;
1175     property glInternalFormat: Cardinal read fglInternalFormat;
1176     property glDataFormat:     Cardinal read fglDataFormat;
1177
1178     property Range: TglBitmapColorRec read fRange;
1179     property Shift: TShiftRec         read fShift;
1180
1181     property RedMask:   QWord read GetRedMask;
1182     property GreenMask: QWord read GetGreenMask;
1183     property BlueMask:  QWord read GetBlueMask;
1184     property AlphaMask: QWord read GetAlphaMask;
1185
1186     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1187     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1188
1189     function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
1190     function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
1191
1192     function CreateMappingData: Pointer; virtual;
1193     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1194
1195     function IsEmpty:  Boolean; virtual;
1196     function HasAlpha: Boolean; virtual;
1197     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1198
1199     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1200
1201     constructor Create; virtual;
1202   public
1203     class procedure Init;
1204     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1205     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1206     class procedure Clear;
1207     class procedure Finalize;
1208   end;
1209   TFormatDescriptorClass = class of TFormatDescriptor;
1210
1211   TfdEmpty = class(TFormatDescriptor);
1212
1213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1214   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1215     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1216     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1217     constructor Create; override;
1218   end;
1219
1220   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1221     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1222     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1223     constructor Create; override;
1224   end;
1225
1226   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1227     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1228     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1229     constructor Create; override;
1230   end;
1231
1232   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1233     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1234     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1235     constructor Create; override;
1236   end;
1237
1238   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1239     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1240     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1241     constructor Create; override;
1242   end;
1243
1244   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1245     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1246     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1247     constructor Create; override;
1248   end;
1249
1250   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1251     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1252     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1253     constructor Create; override;
1254   end;
1255
1256   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1257     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1258     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1259     constructor Create; override;
1260   end;
1261
1262 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1263   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1264     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1265     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1266     constructor Create; override;
1267   end;
1268
1269   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1270     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1271     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1272     constructor Create; override;
1273   end;
1274
1275   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1276     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1277     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1278     constructor Create; override;
1279   end;
1280
1281   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1282     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1283     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1284     constructor Create; override;
1285   end;
1286
1287   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1288     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1289     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1290     constructor Create; override;
1291   end;
1292
1293   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1294     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1295     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1296     constructor Create; override;
1297   end;
1298
1299   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1300     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1301     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1302     constructor Create; override;
1303   end;
1304
1305   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1306     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1307     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1308     constructor Create; override;
1309   end;
1310
1311   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1312     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1313     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1314     constructor Create; override;
1315   end;
1316
1317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1318   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1319     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1320     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1321     constructor Create; override;
1322   end;
1323
1324   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1325     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1326     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1327     constructor Create; override;
1328   end;
1329
1330 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1331   TfdAlpha4 = class(TfdAlpha_UB1)
1332     constructor Create; override;
1333   end;
1334
1335   TfdAlpha8 = class(TfdAlpha_UB1)
1336     constructor Create; override;
1337   end;
1338
1339   TfdAlpha12 = class(TfdAlpha_US1)
1340     constructor Create; override;
1341   end;
1342
1343   TfdAlpha16 = class(TfdAlpha_US1)
1344     constructor Create; override;
1345   end;
1346
1347   TfdLuminance4 = class(TfdLuminance_UB1)
1348     constructor Create; override;
1349   end;
1350
1351   TfdLuminance8 = class(TfdLuminance_UB1)
1352     constructor Create; override;
1353   end;
1354
1355   TfdLuminance12 = class(TfdLuminance_US1)
1356     constructor Create; override;
1357   end;
1358
1359   TfdLuminance16 = class(TfdLuminance_US1)
1360     constructor Create; override;
1361   end;
1362
1363   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1364     constructor Create; override;
1365   end;
1366
1367   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1368     constructor Create; override;
1369   end;
1370
1371   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1372     constructor Create; override;
1373   end;
1374
1375   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1376     constructor Create; override;
1377   end;
1378
1379   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1380     constructor Create; override;
1381   end;
1382
1383   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1384     constructor Create; override;
1385   end;
1386
1387   TfdR3G3B2 = class(TfdUniversal_UB1)
1388     constructor Create; override;
1389   end;
1390
1391   TfdRGB4 = class(TfdUniversal_US1)
1392     constructor Create; override;
1393   end;
1394
1395   TfdR5G6B5 = class(TfdUniversal_US1)
1396     constructor Create; override;
1397   end;
1398
1399   TfdRGB5 = class(TfdUniversal_US1)
1400     constructor Create; override;
1401   end;
1402
1403   TfdRGB8 = class(TfdRGB_UB3)
1404     constructor Create; override;
1405   end;
1406
1407   TfdRGB10 = class(TfdUniversal_UI1)
1408     constructor Create; override;
1409   end;
1410
1411   TfdRGB12 = class(TfdRGB_US3)
1412     constructor Create; override;
1413   end;
1414
1415   TfdRGB16 = class(TfdRGB_US3)
1416     constructor Create; override;
1417   end;
1418
1419   TfdRGBA2 = class(TfdRGBA_UB4)
1420     constructor Create; override;
1421   end;
1422
1423   TfdRGBA4 = class(TfdUniversal_US1)
1424     constructor Create; override;
1425   end;
1426
1427   TfdRGB5A1 = class(TfdUniversal_US1)
1428     constructor Create; override;
1429   end;
1430
1431   TfdRGBA8 = class(TfdRGBA_UB4)
1432     constructor Create; override;
1433   end;
1434
1435   TfdRGB10A2 = class(TfdUniversal_UI1)
1436     constructor Create; override;
1437   end;
1438
1439   TfdRGBA12 = class(TfdRGBA_US4)
1440     constructor Create; override;
1441   end;
1442
1443   TfdRGBA16 = class(TfdRGBA_US4)
1444     constructor Create; override;
1445   end;
1446
1447   TfdBGR4 = class(TfdUniversal_US1)
1448     constructor Create; override;
1449   end;
1450
1451   TfdB5G6R5 = class(TfdUniversal_US1)
1452     constructor Create; override;
1453   end;
1454
1455   TfdBGR5 = class(TfdUniversal_US1)
1456     constructor Create; override;
1457   end;
1458
1459   TfdBGR8 = class(TfdBGR_UB3)
1460     constructor Create; override;
1461   end;
1462
1463   TfdBGR10 = class(TfdUniversal_UI1)
1464     constructor Create; override;
1465   end;
1466
1467   TfdBGR12 = class(TfdBGR_US3)
1468     constructor Create; override;
1469   end;
1470
1471   TfdBGR16 = class(TfdBGR_US3)
1472     constructor Create; override;
1473   end;
1474
1475   TfdBGRA2 = class(TfdBGRA_UB4)
1476     constructor Create; override;
1477   end;
1478
1479   TfdBGRA4 = class(TfdUniversal_US1)
1480     constructor Create; override;
1481   end;
1482
1483   TfdBGR5A1 = class(TfdUniversal_US1)
1484     constructor Create; override;
1485   end;
1486
1487   TfdBGRA8 = class(TfdBGRA_UB4)
1488     constructor Create; override;
1489   end;
1490
1491   TfdBGR10A2 = class(TfdUniversal_UI1)
1492     constructor Create; override;
1493   end;
1494
1495   TfdBGRA12 = class(TfdBGRA_US4)
1496     constructor Create; override;
1497   end;
1498
1499   TfdBGRA16 = class(TfdBGRA_US4)
1500     constructor Create; override;
1501   end;
1502
1503   TfdDepth16 = class(TfdDepth_US1)
1504     constructor Create; override;
1505   end;
1506
1507   TfdDepth24 = class(TfdDepth_UI1)
1508     constructor Create; override;
1509   end;
1510
1511   TfdDepth32 = class(TfdDepth_UI1)
1512     constructor Create; override;
1513   end;
1514
1515   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1516     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1517     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1518     constructor Create; override;
1519   end;
1520
1521   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1522     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1523     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1524     constructor Create; override;
1525   end;
1526
1527   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1528     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1529     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1530     constructor Create; override;
1531   end;
1532
1533 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1534   TbmpBitfieldFormat = class(TFormatDescriptor)
1535   private
1536     procedure SetRedMask  (const aValue: QWord);
1537     procedure SetGreenMask(const aValue: QWord);
1538     procedure SetBlueMask (const aValue: QWord);
1539     procedure SetAlphaMask(const aValue: QWord);
1540
1541     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1542   public
1543     property RedMask:   QWord read GetRedMask   write SetRedMask;
1544     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1545     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1546     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1547
1548     property PixelSize: Single read fPixelSize write fPixelSize;
1549
1550     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1551     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1552   end;
1553
1554 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1555   TbmpColorTableEnty = packed record
1556     b, g, r, a: Byte;
1557   end;
1558   TbmpColorTable = array of TbmpColorTableEnty;
1559   TbmpColorTableFormat = class(TFormatDescriptor)
1560   private
1561     fColorTable: TbmpColorTable;
1562   public
1563     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1564     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1565     property Range:      TglBitmapColorRec read fRange      write fRange;
1566     property Shift:      TShiftRec         read fShift      write fShift;
1567     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1568
1569     procedure CreateColorTable;
1570
1571     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1572     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1573     destructor Destroy; override;
1574   end;
1575
1576 const
1577   LUMINANCE_WEIGHT_R = 0.30;
1578   LUMINANCE_WEIGHT_G = 0.59;
1579   LUMINANCE_WEIGHT_B = 0.11;
1580
1581   ALPHA_WEIGHT_R = 0.30;
1582   ALPHA_WEIGHT_G = 0.59;
1583   ALPHA_WEIGHT_B = 0.11;
1584
1585   DEPTH_WEIGHT_R = 0.333333333;
1586   DEPTH_WEIGHT_G = 0.333333333;
1587   DEPTH_WEIGHT_B = 0.333333333;
1588
1589   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1590
1591   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1592     TfdEmpty,
1593
1594     TfdAlpha4,
1595     TfdAlpha8,
1596     TfdAlpha12,
1597     TfdAlpha16,
1598
1599     TfdLuminance4,
1600     TfdLuminance8,
1601     TfdLuminance12,
1602     TfdLuminance16,
1603
1604     TfdLuminance4Alpha4,
1605     TfdLuminance6Alpha2,
1606     TfdLuminance8Alpha8,
1607     TfdLuminance12Alpha4,
1608     TfdLuminance12Alpha12,
1609     TfdLuminance16Alpha16,
1610
1611     TfdR3G3B2,
1612     TfdRGB4,
1613     TfdR5G6B5,
1614     TfdRGB5,
1615     TfdRGB8,
1616     TfdRGB10,
1617     TfdRGB12,
1618     TfdRGB16,
1619
1620     TfdRGBA2,
1621     TfdRGBA4,
1622     TfdRGB5A1,
1623     TfdRGBA8,
1624     TfdRGB10A2,
1625     TfdRGBA12,
1626     TfdRGBA16,
1627
1628     TfdBGR4,
1629     TfdB5G6R5,
1630     TfdBGR5,
1631     TfdBGR8,
1632     TfdBGR10,
1633     TfdBGR12,
1634     TfdBGR16,
1635
1636     TfdBGRA2,
1637     TfdBGRA4,
1638     TfdBGR5A1,
1639     TfdBGRA8,
1640     TfdBGR10A2,
1641     TfdBGRA12,
1642     TfdBGRA16,
1643
1644     TfdDepth16,
1645     TfdDepth24,
1646     TfdDepth32,
1647
1648     TfdS3tcDtx1RGBA,
1649     TfdS3tcDtx3RGBA,
1650     TfdS3tcDtx5RGBA
1651   );
1652
1653 var
1654   FormatDescriptorCS: TCriticalSection;
1655   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1656
1657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1658 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1659 begin
1660   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1661 end;
1662
1663 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1664 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1665 begin
1666   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1667 end;
1668
1669 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1670 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1671 begin
1672   result.Fields := [];
1673
1674   if X >= 0 then
1675     result.Fields := result.Fields + [ffX];
1676   if Y >= 0 then
1677     result.Fields := result.Fields + [ffY];
1678
1679   result.X := Max(0, X);
1680   result.Y := Max(0, Y);
1681 end;
1682
1683 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1684 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1685 begin
1686   result.r := r;
1687   result.g := g;
1688   result.b := b;
1689   result.a := a;
1690 end;
1691
1692 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1693 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1694 var
1695   i: Integer;
1696 begin
1697   result := false;
1698   for i := 0 to high(r1.arr) do
1699     if (r1.arr[i] <> r2.arr[i]) then
1700       exit;
1701   result := true;
1702 end;
1703
1704 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1705 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1706 begin
1707   result.r := r;
1708   result.g := g;
1709   result.b := b;
1710   result.a := a;
1711 end;
1712
1713 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1714 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1715 begin
1716   result := [];
1717
1718   if (aFormat in [
1719         //4 bbp
1720         tfLuminance4,
1721
1722         //8bpp
1723         tfR3G3B2, tfLuminance8,
1724
1725         //16bpp
1726         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1727         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1728
1729         //24bpp
1730         tfBGR8, tfRGB8,
1731
1732         //32bpp
1733         tfRGB10, tfRGB10A2, tfRGBA8,
1734         tfBGR10, tfBGR10A2, tfBGRA8]) then
1735     result := result + [ftBMP];
1736
1737   if (aFormat in [
1738         //8 bpp
1739         tfLuminance8, tfAlpha8,
1740
1741         //16 bpp
1742         tfLuminance16, tfLuminance8Alpha8,
1743         tfRGB5, tfRGB5A1, tfRGBA4,
1744         tfBGR5, tfBGR5A1, tfBGRA4,
1745
1746         //24 bpp
1747         tfRGB8, tfBGR8,
1748
1749         //32 bpp
1750         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1751     result := result + [ftTGA];
1752
1753   if (aFormat in [
1754         //8 bpp
1755         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1756         tfR3G3B2, tfRGBA2, tfBGRA2,
1757
1758         //16 bpp
1759         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1760         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1761         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1762
1763         //24 bpp
1764         tfRGB8, tfBGR8,
1765
1766         //32 bbp
1767         tfLuminance16Alpha16,
1768         tfRGBA8, tfRGB10A2,
1769         tfBGRA8, tfBGR10A2,
1770
1771         //compressed
1772         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1773     result := result + [ftDDS];
1774
1775   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1776   if aFormat in [
1777       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1778       tfRGB8, tfRGBA8,
1779       tfBGR8, tfBGRA8] then
1780     result := result + [ftPNG];
1781   {$ENDIF}
1782
1783   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1784   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1785     result := result + [ftJPEG];
1786   {$ENDIF}
1787 end;
1788
1789 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1790 function IsPowerOfTwo(aNumber: Integer): Boolean;
1791 begin
1792   while (aNumber and 1) = 0 do
1793     aNumber := aNumber shr 1;
1794   result := aNumber = 1;
1795 end;
1796
1797 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1798 function GetTopMostBit(aBitSet: QWord): Integer;
1799 begin
1800   result := 0;
1801   while aBitSet > 0 do begin
1802     inc(result);
1803     aBitSet := aBitSet shr 1;
1804   end;
1805 end;
1806
1807 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1808 function CountSetBits(aBitSet: QWord): Integer;
1809 begin
1810   result := 0;
1811   while aBitSet > 0 do begin
1812     if (aBitSet and 1) = 1 then
1813       inc(result);
1814     aBitSet := aBitSet shr 1;
1815   end;
1816 end;
1817
1818 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1819 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1820 begin
1821   result := Trunc(
1822     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1823     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1824     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1825 end;
1826
1827 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1828 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1829 begin
1830   result := Trunc(
1831     DEPTH_WEIGHT_R * aPixel.Data.r +
1832     DEPTH_WEIGHT_G * aPixel.Data.g +
1833     DEPTH_WEIGHT_B * aPixel.Data.b);
1834 end;
1835
1836 {$IFDEF GLB_NATIVE_OGL}
1837 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1838 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1839 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1840 var
1841   GL_LibHandle: Pointer = nil;
1842
1843 function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
1844 begin
1845   result :=  nil;
1846
1847   if not Assigned(aLibHandle) then
1848     aLibHandle := GL_LibHandle;
1849
1850 {$IF DEFINED(GLB_WIN)}
1851   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1852   if Assigned(result) then
1853     exit;
1854
1855   if Assigned(wglGetProcAddress) then
1856     result := wglGetProcAddress(aProcName);
1857 {$ELSEIF DEFINED(GLB_LINUX)}
1858   if Assigned(glXGetProcAddress) then begin
1859     result := glXGetProcAddress(aProcName);
1860     if Assigned(result) then
1861       exit;
1862   end;
1863
1864   if Assigned(glXGetProcAddressARB) then begin
1865     result := glXGetProcAddressARB(aProcName);
1866     if Assigned(result) then
1867       exit;
1868   end;
1869
1870   result := dlsym(aLibHandle, aProcName);
1871 {$ENDIF}
1872   if not Assigned(result) then
1873     raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
1874 end;
1875
1876 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1877 var
1878   GLU_LibHandle: Pointer = nil;
1879   OpenGLInitialized: Boolean;
1880   InitOpenGLCS: TCriticalSection;
1881
1882 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1883 procedure glbInitOpenGL;
1884
1885   ////////////////////////////////////////////////////////////////////////////////
1886   function glbLoadLibrary(const aName: PChar): Pointer;
1887   begin
1888     {$IF DEFINED(GLB_WIN)}
1889     result := {%H-}Pointer(LoadLibrary(aName));
1890     {$ELSEIF DEFINED(GLB_LINUX)}
1891     result := dlopen(Name, RTLD_LAZY);
1892     {$ELSE}
1893     result := nil;
1894     {$ENDIF}
1895   end;
1896
1897   ////////////////////////////////////////////////////////////////////////////////
1898   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
1899   begin
1900     result := false;
1901     if not Assigned(aLibHandle) then
1902       exit;
1903
1904     {$IF DEFINED(GLB_WIN)}
1905     Result := FreeLibrary({%H-}HINST(aLibHandle));
1906     {$ELSEIF DEFINED(GLB_LINUX)}
1907     Result := dlclose(aLibHandle) = 0;
1908     {$ENDIF}
1909   end;
1910
1911 begin
1912   if Assigned(GL_LibHandle) then
1913     glbFreeLibrary(GL_LibHandle);
1914
1915   if Assigned(GLU_LibHandle) then
1916     glbFreeLibrary(GLU_LibHandle);
1917
1918   GL_LibHandle := glbLoadLibrary(libopengl);
1919   if not Assigned(GL_LibHandle) then
1920     raise EglBitmapException.Create('unable to load library: ' + libopengl);
1921
1922   GLU_LibHandle := glbLoadLibrary(libglu);
1923   if not Assigned(GLU_LibHandle) then
1924     raise EglBitmapException.Create('unable to load library: ' + libglu);
1925
1926   try
1927   {$IF DEFINED(GLB_WIN)}
1928     wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
1929   {$ELSEIF DEFINED(GLB_LINUX)}
1930     glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
1931     glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB');
1932   {$ENDIF}
1933
1934     glEnable := glbGetProcAddress('glEnable');
1935     glDisable := glbGetProcAddress('glDisable');
1936     glGetString := glbGetProcAddress('glGetString');
1937     glGetIntegerv := glbGetProcAddress('glGetIntegerv');
1938     glTexParameteri := glbGetProcAddress('glTexParameteri');
1939     glTexParameterfv := glbGetProcAddress('glTexParameterfv');
1940     glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
1941     glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
1942     glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
1943     glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
1944     glGenTextures := glbGetProcAddress('glGenTextures');
1945     glBindTexture := glbGetProcAddress('glBindTexture');
1946     glDeleteTextures := glbGetProcAddress('glDeleteTextures');
1947     glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
1948     glReadPixels := glbGetProcAddress('glReadPixels');
1949     glPixelStorei := glbGetProcAddress('glPixelStorei');
1950     glTexImage1D := glbGetProcAddress('glTexImage1D');
1951     glTexImage2D := glbGetProcAddress('glTexImage2D');
1952     glGetTexImage := glbGetProcAddress('glGetTexImage');
1953
1954     gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
1955     gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
1956   finally
1957     glbFreeLibrary(GL_LibHandle);
1958     glbFreeLibrary(GLU_LibHandle);
1959   end;
1960 end;
1961 {$ENDIF}
1962
1963 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1964 procedure glbReadOpenGLExtensions;
1965 var
1966   {$IFDEF GLB_DELPHI}
1967   Context: HGLRC;
1968   {$ENDIF}
1969   Buffer: AnsiString;
1970   MajorVersion, MinorVersion: Integer;
1971
1972   ///////////////////////////////////////////////////////////////////////////////////////////
1973   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
1974   var
1975     Separator: Integer;
1976   begin
1977     aMinor := 0;
1978     aMajor := 0;
1979
1980     Separator := Pos(AnsiString('.'), aBuffer);
1981     if (Separator > 1) and (Separator < Length(aBuffer)) and
1982        (aBuffer[Separator - 1] in ['0'..'9']) and
1983        (aBuffer[Separator + 1] in ['0'..'9']) then begin
1984
1985       Dec(Separator);
1986       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
1987         Dec(Separator);
1988
1989       Delete(aBuffer, 1, Separator);
1990       Separator := Pos(AnsiString('.'), aBuffer) + 1;
1991
1992       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
1993         Inc(Separator);
1994
1995       Delete(aBuffer, Separator, 255);
1996       Separator := Pos(AnsiString('.'), aBuffer);
1997
1998       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
1999       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2000     end;
2001   end;
2002
2003   ///////////////////////////////////////////////////////////////////////////////////////////
2004   function CheckExtension(const Extension: AnsiString): Boolean;
2005   var
2006     ExtPos: Integer;
2007   begin
2008     ExtPos := Pos(Extension, Buffer);
2009     result := ExtPos > 0;
2010     if result then
2011       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2012   end;
2013
2014 begin
2015 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2016   InitOpenGLCS.Enter;
2017   try
2018     if not OpenGLInitialized then begin
2019       glbInitOpenGL;
2020       OpenGLInitialized := true;
2021     end;
2022   finally
2023     InitOpenGLCS.Leave;
2024   end;
2025 {$ENDIF}
2026
2027 {$IFDEF GLB_DELPHI}
2028   Context := wglGetCurrentContext;
2029   if (Context <> gLastContext) then begin
2030     gLastContext := Context;
2031 {$ENDIF}
2032
2033     // Version
2034     Buffer := glGetString(GL_VERSION);
2035     TrimVersionString(Buffer, MajorVersion, MinorVersion);
2036
2037     GL_VERSION_1_2 := false;
2038     GL_VERSION_1_3 := false;
2039     GL_VERSION_1_4 := false;
2040     GL_VERSION_2_0 := false;
2041     if MajorVersion = 1 then begin
2042       if MinorVersion >= 2 then
2043         GL_VERSION_1_2 := true;
2044
2045       if MinorVersion >= 3 then
2046         GL_VERSION_1_3 := true;
2047
2048       if MinorVersion >= 4 then
2049         GL_VERSION_1_4 := true;
2050     end else if MajorVersion >= 2 then begin
2051       GL_VERSION_1_2 := true;
2052       GL_VERSION_1_3 := true;
2053       GL_VERSION_1_4 := true;
2054       GL_VERSION_2_0 := true;
2055     end;
2056
2057     // Extensions
2058     Buffer := glGetString(GL_EXTENSIONS);
2059     GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2060     GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2061     GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2062     GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2063     GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2064     GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2065     GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2066     GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2067     GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2068     GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2069
2070     if GL_VERSION_1_3 then begin
2071       glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2072       glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2073       glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2074     end else begin
2075       glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB');
2076       glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB');
2077       glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
2078     end;
2079 {$IFDEF GLB_DELPHI}
2080   end;
2081 {$ENDIF}
2082 end;
2083 {$ENDIF}
2084
2085 (* TODO GLB_DELPHI
2086 {$IFDEF GLB_DELPHI}
2087 function CreateGrayPalette: HPALETTE;
2088 var
2089   Idx: Integer;
2090   Pal: PLogPalette;
2091 begin
2092   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
2093
2094   Pal.palVersion := $300;
2095   Pal.palNumEntries := 256;
2096
2097   {$IFOPT R+}
2098     {$DEFINE GLB_TEMPRANGECHECK}
2099     {$R-}
2100   {$ENDIF}
2101
2102   for Idx := 0 to 256 - 1 do begin
2103     Pal.palPalEntry[Idx].peRed   := Idx;
2104     Pal.palPalEntry[Idx].peGreen := Idx;
2105     Pal.palPalEntry[Idx].peBlue  := Idx;
2106     Pal.palPalEntry[Idx].peFlags := 0;
2107   end;
2108
2109   {$IFDEF GLB_TEMPRANGECHECK}
2110     {$UNDEF GLB_TEMPRANGECHECK}
2111     {$R+}
2112   {$ENDIF}
2113
2114   result := CreatePalette(Pal^);
2115
2116   FreeMem(Pal);
2117 end;
2118 {$ENDIF}
2119 *)
2120
2121 {$IFDEF GLB_SDL_IMAGE}
2122 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2123 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2124 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2125 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2126 begin
2127   result := TStream(context^.unknown.data1).Seek(offset, whence);
2128 end;
2129
2130 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2131 begin
2132   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2133 end;
2134
2135 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2136 begin
2137   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2138 end;
2139
2140 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2141 begin
2142   result := 0;
2143 end;
2144
2145 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2146 begin
2147   result := SDL_AllocRW;
2148
2149   if result = nil then
2150     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2151
2152   result^.seek := glBitmapRWseek;
2153   result^.read := glBitmapRWread;
2154   result^.write := glBitmapRWwrite;
2155   result^.close := glBitmapRWclose;
2156   result^.unknown.data1 := Stream;
2157 end;
2158 {$ENDIF}
2159
2160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2161 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2162 begin
2163   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2164 end;
2165
2166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2167 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2168 begin
2169   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2170 end;
2171
2172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2173 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2174 begin
2175   glBitmapDefaultMipmap := aValue;
2176 end;
2177
2178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2179 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2180 begin
2181   glBitmapDefaultFormat := aFormat;
2182 end;
2183
2184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2185 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2186 begin
2187   glBitmapDefaultFilterMin := aMin;
2188   glBitmapDefaultFilterMag := aMag;
2189 end;
2190
2191 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2192 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2193 begin
2194   glBitmapDefaultWrapS := S;
2195   glBitmapDefaultWrapT := T;
2196   glBitmapDefaultWrapR := R;
2197 end;
2198
2199 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2200 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2201 begin
2202   result := glBitmapDefaultDeleteTextureOnFree;
2203 end;
2204
2205 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2206 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2207 begin
2208   result := glBitmapDefaultFreeDataAfterGenTextures;
2209 end;
2210
2211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2212 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2213 begin
2214   result := glBitmapDefaultMipmap;
2215 end;
2216
2217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2218 function glBitmapGetDefaultFormat: TglBitmapFormat;
2219 begin
2220   result := glBitmapDefaultFormat;
2221 end;
2222
2223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2224 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2225 begin
2226   aMin := glBitmapDefaultFilterMin;
2227   aMag := glBitmapDefaultFilterMag;
2228 end;
2229
2230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2231 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2232 begin
2233   S := glBitmapDefaultWrapS;
2234   T := glBitmapDefaultWrapT;
2235   R := glBitmapDefaultWrapR;
2236 end;
2237
2238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2239 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2241 function TFormatDescriptor.GetRedMask: QWord;
2242 begin
2243   result := fRange.r shl fShift.r;
2244 end;
2245
2246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2247 function TFormatDescriptor.GetGreenMask: QWord;
2248 begin
2249   result := fRange.g shl fShift.g;
2250 end;
2251
2252 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2253 function TFormatDescriptor.GetBlueMask: QWord;
2254 begin
2255   result := fRange.b shl fShift.b;
2256 end;
2257
2258 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2259 function TFormatDescriptor.GetAlphaMask: QWord;
2260 begin
2261   result := fRange.a shl fShift.a;
2262 end;
2263
2264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2265 function TFormatDescriptor.GetComponents: Integer;
2266 var
2267   i: Integer;
2268 begin
2269   result := 0;
2270   for i := 0 to 3 do
2271     if (fRange.arr[i] > 0) then
2272       inc(result);
2273 end;
2274
2275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2276 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2277 var
2278   w, h: Integer;
2279 begin
2280   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2281     w := Max(1, aSize.X);
2282     h := Max(1, aSize.Y);
2283     result := GetSize(w, h);
2284   end else
2285     result := 0;
2286 end;
2287
2288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2289 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2290 begin
2291   result := 0;
2292   if (aWidth <= 0) or (aHeight <= 0) then
2293     exit;
2294   result := Ceil(aWidth * aHeight * fPixelSize);
2295 end;
2296
2297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2298 function TFormatDescriptor.CreateMappingData: Pointer;
2299 begin
2300   result := nil;
2301 end;
2302
2303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2304 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2305 begin
2306   //DUMMY
2307 end;
2308
2309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2310 function TFormatDescriptor.IsEmpty: Boolean;
2311 begin
2312   result := (fFormat = tfEmpty);
2313 end;
2314
2315 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2316 function TFormatDescriptor.HasAlpha: Boolean;
2317 begin
2318   result := (fRange.a > 0);
2319 end;
2320
2321 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2322 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2323 begin
2324   result := false;
2325   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2326     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2327   if (aRedMask   <> RedMask) then
2328     exit;
2329   if (aGreenMask <> GreenMask) then
2330     exit;
2331   if (aBlueMask  <> BlueMask) then
2332     exit;
2333   if (aAlphaMask <> AlphaMask) then
2334     exit;
2335   result := true;
2336 end;
2337
2338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2339 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2340 begin
2341   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2342   aPixel.Data   := fRange;
2343   aPixel.Range  := fRange;
2344   aPixel.Format := fFormat;
2345 end;
2346
2347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2348 constructor TFormatDescriptor.Create;
2349 begin
2350   inherited Create;
2351
2352   fFormat       := tfEmpty;
2353   fWithAlpha    := tfEmpty;
2354   fWithoutAlpha := tfEmpty;
2355   fRGBInverted  := tfEmpty;
2356   fUncompressed := tfEmpty;
2357   fPixelSize    := 0.0;
2358   fIsCompressed := false;
2359
2360   fglFormat         := 0;
2361   fglInternalFormat := 0;
2362   fglDataFormat     := 0;
2363
2364   FillChar(fRange, 0, SizeOf(fRange));
2365   FillChar(fShift, 0, SizeOf(fShift));
2366 end;
2367
2368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2369 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2371 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2372 begin
2373   aData^ := aPixel.Data.a;
2374   inc(aData);
2375 end;
2376
2377 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2378 begin
2379   aPixel.Data.r := 0;
2380   aPixel.Data.g := 0;
2381   aPixel.Data.b := 0;
2382   aPixel.Data.a := aData^;
2383   inc(aData);
2384 end;
2385
2386 constructor TfdAlpha_UB1.Create;
2387 begin
2388   inherited Create;
2389   fPixelSize        := 1.0;
2390   fRange.a          := $FF;
2391   fglFormat         := GL_ALPHA;
2392   fglDataFormat     := GL_UNSIGNED_BYTE;
2393 end;
2394
2395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2396 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2397 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2398 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2399 begin
2400   aData^ := LuminanceWeight(aPixel);
2401   inc(aData);
2402 end;
2403
2404 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2405 begin
2406   aPixel.Data.r := aData^;
2407   aPixel.Data.g := aData^;
2408   aPixel.Data.b := aData^;
2409   aPixel.Data.a := 0;
2410   inc(aData);
2411 end;
2412
2413 constructor TfdLuminance_UB1.Create;
2414 begin
2415   inherited Create;
2416   fPixelSize        := 1.0;
2417   fRange.r          := $FF;
2418   fRange.g          := $FF;
2419   fRange.b          := $FF;
2420   fglFormat         := GL_LUMINANCE;
2421   fglDataFormat     := GL_UNSIGNED_BYTE;
2422 end;
2423
2424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2425 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2427 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2428 var
2429   i: Integer;
2430 begin
2431   aData^ := 0;
2432   for i := 0 to 3 do
2433     if (fRange.arr[i] > 0) then
2434       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2435   inc(aData);
2436 end;
2437
2438 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2439 var
2440   i: Integer;
2441 begin
2442   for i := 0 to 3 do
2443     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2444   inc(aData);
2445 end;
2446
2447 constructor TfdUniversal_UB1.Create;
2448 begin
2449   inherited Create;
2450   fPixelSize := 1.0;
2451 end;
2452
2453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2454 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2455 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2456 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2457 begin
2458   inherited Map(aPixel, aData, aMapData);
2459   aData^ := aPixel.Data.a;
2460   inc(aData);
2461 end;
2462
2463 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2464 begin
2465   inherited Unmap(aData, aPixel, aMapData);
2466   aPixel.Data.a := aData^;
2467   inc(aData);
2468 end;
2469
2470 constructor TfdLuminanceAlpha_UB2.Create;
2471 begin
2472   inherited Create;
2473   fPixelSize        := 2.0;
2474   fRange.a          := $FF;
2475   fShift.a          :=   8;
2476   fglFormat         := GL_LUMINANCE_ALPHA;
2477   fglDataFormat     := GL_UNSIGNED_BYTE;
2478 end;
2479
2480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2481 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2483 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2484 begin
2485   aData^ := aPixel.Data.r;
2486   inc(aData);
2487   aData^ := aPixel.Data.g;
2488   inc(aData);
2489   aData^ := aPixel.Data.b;
2490   inc(aData);
2491 end;
2492
2493 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2494 begin
2495   aPixel.Data.r := aData^;
2496   inc(aData);
2497   aPixel.Data.g := aData^;
2498   inc(aData);
2499   aPixel.Data.b := aData^;
2500   inc(aData);
2501   aPixel.Data.a := 0;
2502 end;
2503
2504 constructor TfdRGB_UB3.Create;
2505 begin
2506   inherited Create;
2507   fPixelSize        := 3.0;
2508   fRange.r          := $FF;
2509   fRange.g          := $FF;
2510   fRange.b          := $FF;
2511   fShift.r          :=   0;
2512   fShift.g          :=   8;
2513   fShift.b          :=  16;
2514   fglFormat         := GL_RGB;
2515   fglDataFormat     := GL_UNSIGNED_BYTE;
2516 end;
2517
2518 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2519 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2521 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2522 begin
2523   aData^ := aPixel.Data.b;
2524   inc(aData);
2525   aData^ := aPixel.Data.g;
2526   inc(aData);
2527   aData^ := aPixel.Data.r;
2528   inc(aData);
2529 end;
2530
2531 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2532 begin
2533   aPixel.Data.b := aData^;
2534   inc(aData);
2535   aPixel.Data.g := aData^;
2536   inc(aData);
2537   aPixel.Data.r := aData^;
2538   inc(aData);
2539   aPixel.Data.a := 0;
2540 end;
2541
2542 constructor TfdBGR_UB3.Create;
2543 begin
2544   fPixelSize        := 3.0;
2545   fRange.r          := $FF;
2546   fRange.g          := $FF;
2547   fRange.b          := $FF;
2548   fShift.r          :=  16;
2549   fShift.g          :=   8;
2550   fShift.b          :=   0;
2551   fglFormat         := GL_BGR;
2552   fglDataFormat     := GL_UNSIGNED_BYTE;
2553 end;
2554
2555 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2556 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2558 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2559 begin
2560   inherited Map(aPixel, aData, aMapData);
2561   aData^ := aPixel.Data.a;
2562   inc(aData);
2563 end;
2564
2565 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2566 begin
2567   inherited Unmap(aData, aPixel, aMapData);
2568   aPixel.Data.a := aData^;
2569   inc(aData);
2570 end;
2571
2572 constructor TfdRGBA_UB4.Create;
2573 begin
2574   inherited Create;
2575   fPixelSize        := 4.0;
2576   fRange.a          := $FF;
2577   fShift.a          :=  24;
2578   fglFormat         := GL_RGBA;
2579   fglDataFormat     := GL_UNSIGNED_BYTE;
2580 end;
2581
2582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2583 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2584 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2585 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2586 begin
2587   inherited Map(aPixel, aData, aMapData);
2588   aData^ := aPixel.Data.a;
2589   inc(aData);
2590 end;
2591
2592 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2593 begin
2594   inherited Unmap(aData, aPixel, aMapData);
2595   aPixel.Data.a := aData^;
2596   inc(aData);
2597 end;
2598
2599 constructor TfdBGRA_UB4.Create;
2600 begin
2601   inherited Create;
2602   fPixelSize        := 4.0;
2603   fRange.a          := $FF;
2604   fShift.a          :=  24;
2605   fglFormat         := GL_BGRA;
2606   fglDataFormat     := GL_UNSIGNED_BYTE;
2607 end;
2608
2609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2610 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2612 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2613 begin
2614   PWord(aData)^ := aPixel.Data.a;
2615   inc(aData, 2);
2616 end;
2617
2618 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2619 begin
2620   aPixel.Data.r := 0;
2621   aPixel.Data.g := 0;
2622   aPixel.Data.b := 0;
2623   aPixel.Data.a := PWord(aData)^;
2624   inc(aData, 2);
2625 end;
2626
2627 constructor TfdAlpha_US1.Create;
2628 begin
2629   inherited Create;
2630   fPixelSize        := 2.0;
2631   fRange.a          := $FFFF;
2632   fglFormat         := GL_ALPHA;
2633   fglDataFormat     := GL_UNSIGNED_SHORT;
2634 end;
2635
2636 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2637 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2639 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2640 begin
2641   PWord(aData)^ := LuminanceWeight(aPixel);
2642   inc(aData, 2);
2643 end;
2644
2645 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2646 begin
2647   aPixel.Data.r := PWord(aData)^;
2648   aPixel.Data.g := PWord(aData)^;
2649   aPixel.Data.b := PWord(aData)^;
2650   aPixel.Data.a := 0;
2651   inc(aData, 2);
2652 end;
2653
2654 constructor TfdLuminance_US1.Create;
2655 begin
2656   inherited Create;
2657   fPixelSize        := 2.0;
2658   fRange.r          := $FFFF;
2659   fRange.g          := $FFFF;
2660   fRange.b          := $FFFF;
2661   fglFormat         := GL_LUMINANCE;
2662   fglDataFormat     := GL_UNSIGNED_SHORT;
2663 end;
2664
2665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2666 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2667 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2668 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2669 var
2670   i: Integer;
2671 begin
2672   PWord(aData)^ := 0;
2673   for i := 0 to 3 do
2674     if (fRange.arr[i] > 0) then
2675       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2676   inc(aData, 2);
2677 end;
2678
2679 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2680 var
2681   i: Integer;
2682 begin
2683   for i := 0 to 3 do
2684     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2685   inc(aData, 2);
2686 end;
2687
2688 constructor TfdUniversal_US1.Create;
2689 begin
2690   inherited Create;
2691   fPixelSize := 2.0;
2692 end;
2693
2694 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2695 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2696 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2697 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2698 begin
2699   PWord(aData)^ := DepthWeight(aPixel);
2700   inc(aData, 2);
2701 end;
2702
2703 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2704 begin
2705   aPixel.Data.r := PWord(aData)^;
2706   aPixel.Data.g := PWord(aData)^;
2707   aPixel.Data.b := PWord(aData)^;
2708   aPixel.Data.a := 0;
2709   inc(aData, 2);
2710 end;
2711
2712 constructor TfdDepth_US1.Create;
2713 begin
2714   inherited Create;
2715   fPixelSize        := 2.0;
2716   fRange.r          := $FFFF;
2717   fRange.g          := $FFFF;
2718   fRange.b          := $FFFF;
2719   fglFormat         := GL_DEPTH_COMPONENT;
2720   fglDataFormat     := GL_UNSIGNED_SHORT;
2721 end;
2722
2723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2724 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2726 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2727 begin
2728   inherited Map(aPixel, aData, aMapData);
2729   PWord(aData)^ := aPixel.Data.a;
2730   inc(aData, 2);
2731 end;
2732
2733 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2734 begin
2735   inherited Unmap(aData, aPixel, aMapData);
2736   aPixel.Data.a := PWord(aData)^;
2737   inc(aData, 2);
2738 end;
2739
2740 constructor TfdLuminanceAlpha_US2.Create;
2741 begin
2742   inherited Create;
2743   fPixelSize        :=   4.0;
2744   fRange.a          := $FFFF;
2745   fShift.a          :=    16;
2746   fglFormat         := GL_LUMINANCE_ALPHA;
2747   fglDataFormat     := GL_UNSIGNED_SHORT;
2748 end;
2749
2750 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2751 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2752 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2753 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2754 begin
2755   PWord(aData)^ := aPixel.Data.r;
2756   inc(aData, 2);
2757   PWord(aData)^ := aPixel.Data.g;
2758   inc(aData, 2);
2759   PWord(aData)^ := aPixel.Data.b;
2760   inc(aData, 2);
2761 end;
2762
2763 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2764 begin
2765   aPixel.Data.r := PWord(aData)^;
2766   inc(aData, 2);
2767   aPixel.Data.g := PWord(aData)^;
2768   inc(aData, 2);
2769   aPixel.Data.b := PWord(aData)^;
2770   inc(aData, 2);
2771   aPixel.Data.a := 0;
2772 end;
2773
2774 constructor TfdRGB_US3.Create;
2775 begin
2776   inherited Create;
2777   fPixelSize        :=   6.0;
2778   fRange.r          := $FFFF;
2779   fRange.g          := $FFFF;
2780   fRange.b          := $FFFF;
2781   fShift.r          :=     0;
2782   fShift.g          :=    16;
2783   fShift.b          :=    32;
2784   fglFormat         := GL_RGB;
2785   fglDataFormat     := GL_UNSIGNED_SHORT;
2786 end;
2787
2788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2789 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2791 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2792 begin
2793   PWord(aData)^ := aPixel.Data.b;
2794   inc(aData, 2);
2795   PWord(aData)^ := aPixel.Data.g;
2796   inc(aData, 2);
2797   PWord(aData)^ := aPixel.Data.r;
2798   inc(aData, 2);
2799 end;
2800
2801 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2802 begin
2803   aPixel.Data.b := PWord(aData)^;
2804   inc(aData, 2);
2805   aPixel.Data.g := PWord(aData)^;
2806   inc(aData, 2);
2807   aPixel.Data.r := PWord(aData)^;
2808   inc(aData, 2);
2809   aPixel.Data.a := 0;
2810 end;
2811
2812 constructor TfdBGR_US3.Create;
2813 begin
2814   inherited Create;
2815   fPixelSize        :=   6.0;
2816   fRange.r          := $FFFF;
2817   fRange.g          := $FFFF;
2818   fRange.b          := $FFFF;
2819   fShift.r          :=    32;
2820   fShift.g          :=    16;
2821   fShift.b          :=     0;
2822   fglFormat         := GL_BGR;
2823   fglDataFormat     := GL_UNSIGNED_SHORT;
2824 end;
2825
2826 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2827 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2828 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2829 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2830 begin
2831   inherited Map(aPixel, aData, aMapData);
2832   PWord(aData)^ := aPixel.Data.a;
2833   inc(aData, 2);
2834 end;
2835
2836 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2837 begin
2838   inherited Unmap(aData, aPixel, aMapData);
2839   aPixel.Data.a := PWord(aData)^;
2840   inc(aData, 2);
2841 end;
2842
2843 constructor TfdRGBA_US4.Create;
2844 begin
2845   inherited Create;
2846   fPixelSize        :=   8.0;
2847   fRange.a          := $FFFF;
2848   fShift.a          :=    48;
2849   fglFormat         := GL_RGBA;
2850   fglDataFormat     := GL_UNSIGNED_SHORT;
2851 end;
2852
2853 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2854 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2855 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2856 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2857 begin
2858   inherited Map(aPixel, aData, aMapData);
2859   PWord(aData)^ := aPixel.Data.a;
2860   inc(aData, 2);
2861 end;
2862
2863 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2864 begin
2865   inherited Unmap(aData, aPixel, aMapData);
2866   aPixel.Data.a := PWord(aData)^;
2867   inc(aData, 2);
2868 end;
2869
2870 constructor TfdBGRA_US4.Create;
2871 begin
2872   inherited Create;
2873   fPixelSize        :=   8.0;
2874   fRange.a          := $FFFF;
2875   fShift.a          :=    48;
2876   fglFormat         := GL_BGRA;
2877   fglDataFormat     := GL_UNSIGNED_SHORT;
2878 end;
2879
2880 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2881 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2883 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2884 var
2885   i: Integer;
2886 begin
2887   PCardinal(aData)^ := 0;
2888   for i := 0 to 3 do
2889     if (fRange.arr[i] > 0) then
2890       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2891   inc(aData, 4);
2892 end;
2893
2894 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2895 var
2896   i: Integer;
2897 begin
2898   for i := 0 to 3 do
2899     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2900   inc(aData, 2);
2901 end;
2902
2903 constructor TfdUniversal_UI1.Create;
2904 begin
2905   inherited Create;
2906   fPixelSize := 4.0;
2907 end;
2908
2909 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2910 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2911 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2912 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2913 begin
2914   PCardinal(aData)^ := DepthWeight(aPixel);
2915   inc(aData, 4);
2916 end;
2917
2918 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2919 begin
2920   aPixel.Data.r := PCardinal(aData)^;
2921   aPixel.Data.g := PCardinal(aData)^;
2922   aPixel.Data.b := PCardinal(aData)^;
2923   aPixel.Data.a := 0;
2924   inc(aData, 4);
2925 end;
2926
2927 constructor TfdDepth_UI1.Create;
2928 begin
2929   inherited Create;
2930   fPixelSize        := 4.0;
2931   fRange.r          := $FFFFFFFF;
2932   fRange.g          := $FFFFFFFF;
2933   fRange.b          := $FFFFFFFF;
2934   fglFormat         := GL_DEPTH_COMPONENT;
2935   fglDataFormat     := GL_UNSIGNED_INT;
2936 end;
2937
2938 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2939 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2940 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2941 constructor TfdAlpha4.Create;
2942 begin
2943   inherited Create;
2944   fFormat           := tfAlpha4;
2945   fWithAlpha        := tfAlpha4;
2946   fglInternalFormat := GL_ALPHA4;
2947 end;
2948
2949 constructor TfdAlpha8.Create;
2950 begin
2951   inherited Create;
2952   fFormat           := tfAlpha8;
2953   fWithAlpha        := tfAlpha8;
2954   fglInternalFormat := GL_ALPHA8;
2955 end;
2956
2957 constructor TfdAlpha12.Create;
2958 begin
2959   inherited Create;
2960   fFormat           := tfAlpha12;
2961   fWithAlpha        := tfAlpha12;
2962   fglInternalFormat := GL_ALPHA12;
2963 end;
2964
2965 constructor TfdAlpha16.Create;
2966 begin
2967   inherited Create;
2968   fFormat           := tfAlpha16;
2969   fWithAlpha        := tfAlpha16;
2970   fglInternalFormat := GL_ALPHA16;
2971 end;
2972
2973 constructor TfdLuminance4.Create;
2974 begin
2975   inherited Create;
2976   fFormat           := tfLuminance4;
2977   fWithAlpha        := tfLuminance4Alpha4;
2978   fWithoutAlpha     := tfLuminance4;
2979   fglInternalFormat := GL_LUMINANCE4;
2980 end;
2981
2982 constructor TfdLuminance8.Create;
2983 begin
2984   inherited Create;
2985   fFormat           := tfLuminance8;
2986   fWithAlpha        := tfLuminance8Alpha8;
2987   fWithoutAlpha     := tfLuminance8;
2988   fglInternalFormat := GL_LUMINANCE8;
2989 end;
2990
2991 constructor TfdLuminance12.Create;
2992 begin
2993   inherited Create;
2994   fFormat           := tfLuminance12;
2995   fWithAlpha        := tfLuminance12Alpha12;
2996   fWithoutAlpha     := tfLuminance12;
2997   fglInternalFormat := GL_LUMINANCE12;
2998 end;
2999
3000 constructor TfdLuminance16.Create;
3001 begin
3002   inherited Create;
3003   fFormat           := tfLuminance16;
3004   fWithAlpha        := tfLuminance16Alpha16;
3005   fWithoutAlpha     := tfLuminance16;
3006   fglInternalFormat := GL_LUMINANCE16;
3007 end;
3008
3009 constructor TfdLuminance4Alpha4.Create;
3010 begin
3011   inherited Create;
3012   fFormat           := tfLuminance4Alpha4;
3013   fWithAlpha        := tfLuminance4Alpha4;
3014   fWithoutAlpha     := tfLuminance4;
3015   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3016 end;
3017
3018 constructor TfdLuminance6Alpha2.Create;
3019 begin
3020   inherited Create;
3021   fFormat           := tfLuminance6Alpha2;
3022   fWithAlpha        := tfLuminance6Alpha2;
3023   fWithoutAlpha     := tfLuminance8;
3024   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3025 end;
3026
3027 constructor TfdLuminance8Alpha8.Create;
3028 begin
3029   inherited Create;
3030   fFormat           := tfLuminance8Alpha8;
3031   fWithAlpha        := tfLuminance8Alpha8;
3032   fWithoutAlpha     := tfLuminance8;
3033   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3034 end;
3035
3036 constructor TfdLuminance12Alpha4.Create;
3037 begin
3038   inherited Create;
3039   fFormat           := tfLuminance12Alpha4;
3040   fWithAlpha        := tfLuminance12Alpha4;
3041   fWithoutAlpha     := tfLuminance12;
3042   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3043 end;
3044
3045 constructor TfdLuminance12Alpha12.Create;
3046 begin
3047   inherited Create;
3048   fFormat           := tfLuminance12Alpha12;
3049   fWithAlpha        := tfLuminance12Alpha12;
3050   fWithoutAlpha     := tfLuminance12;
3051   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3052 end;
3053
3054 constructor TfdLuminance16Alpha16.Create;
3055 begin
3056   inherited Create;
3057   fFormat           := tfLuminance16Alpha16;
3058   fWithAlpha        := tfLuminance16Alpha16;
3059   fWithoutAlpha     := tfLuminance16;
3060   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3061 end;
3062
3063 constructor TfdR3G3B2.Create;
3064 begin
3065   inherited Create;
3066   fFormat           := tfR3G3B2;
3067   fWithAlpha        := tfRGBA2;
3068   fWithoutAlpha     := tfR3G3B2;
3069   fRange.r          := $7;
3070   fRange.g          := $7;
3071   fRange.b          := $3;
3072   fShift.r          :=  0;
3073   fShift.g          :=  3;
3074   fShift.b          :=  6;
3075   fglFormat         := GL_RGB;
3076   fglInternalFormat := GL_R3_G3_B2;
3077   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3078 end;
3079
3080 constructor TfdRGB4.Create;
3081 begin
3082   inherited Create;
3083   fFormat           := tfRGB4;
3084   fWithAlpha        := tfRGBA4;
3085   fWithoutAlpha     := tfRGB4;
3086   fRGBInverted      := tfBGR4;
3087   fRange.r          := $F;
3088   fRange.g          := $F;
3089   fRange.b          := $F;
3090   fShift.r          :=  0;
3091   fShift.g          :=  4;
3092   fShift.b          :=  8;
3093   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3094   fglInternalFormat := GL_RGB4;
3095   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3096 end;
3097
3098 constructor TfdR5G6B5.Create;
3099 begin
3100   inherited Create;
3101   fFormat           := tfR5G6B5;
3102   fWithAlpha        := tfRGBA4;
3103   fWithoutAlpha     := tfR5G6B5;
3104   fRGBInverted      := tfB5G6R5;
3105   fRange.r          := $1F;
3106   fRange.g          := $3F;
3107   fRange.b          := $1F;
3108   fShift.r          :=   0;
3109   fShift.g          :=   5;
3110   fShift.b          :=  11;
3111   fglFormat         := GL_RGB;
3112   fglInternalFormat := GL_RGB565;
3113   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3114 end;
3115
3116 constructor TfdRGB5.Create;
3117 begin
3118   inherited Create;
3119   fFormat           := tfRGB5;
3120   fWithAlpha        := tfRGB5A1;
3121   fWithoutAlpha     := tfRGB5;
3122   fRGBInverted      := tfBGR5;
3123   fRange.r          := $1F;
3124   fRange.g          := $1F;
3125   fRange.b          := $1F;
3126   fShift.r          :=   0;
3127   fShift.g          :=   5;
3128   fShift.b          :=  10;
3129   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3130   fglInternalFormat := GL_RGB5;
3131   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3132 end;
3133
3134 constructor TfdRGB8.Create;
3135 begin
3136   inherited Create;
3137   fFormat           := tfRGB8;
3138   fWithAlpha        := tfRGBA8;
3139   fWithoutAlpha     := tfRGB8;
3140   fRGBInverted      := tfBGR8;
3141   fglInternalFormat := GL_RGB8;
3142 end;
3143
3144 constructor TfdRGB10.Create;
3145 begin
3146   inherited Create;
3147   fFormat           := tfRGB10;
3148   fWithAlpha        := tfRGB10A2;
3149   fWithoutAlpha     := tfRGB10;
3150   fRGBInverted      := tfBGR10;
3151   fRange.r          := $3FF;
3152   fRange.g          := $3FF;
3153   fRange.b          := $3FF;
3154   fShift.r          :=    0;
3155   fShift.g          :=   10;
3156   fShift.b          :=   20;
3157   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3158   fglInternalFormat := GL_RGB10;
3159   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3160 end;
3161
3162 constructor TfdRGB12.Create;
3163 begin
3164   inherited Create;
3165   fFormat           := tfRGB12;
3166   fWithAlpha        := tfRGBA12;
3167   fWithoutAlpha     := tfRGB12;
3168   fRGBInverted      := tfBGR12;
3169   fglInternalFormat := GL_RGB12;
3170 end;
3171
3172 constructor TfdRGB16.Create;
3173 begin
3174   inherited Create;
3175   fFormat           := tfRGB16;
3176   fWithAlpha        := tfRGBA16;
3177   fWithoutAlpha     := tfRGB16;
3178   fRGBInverted      := tfBGR16;
3179   fglInternalFormat := GL_RGB16;
3180 end;
3181
3182 constructor TfdRGBA2.Create;
3183 begin
3184   inherited Create;
3185   fFormat           := tfRGBA2;
3186   fWithAlpha        := tfRGBA2;
3187   fWithoutAlpha     := tfR3G3B2;
3188   fRGBInverted      := tfBGRA2;
3189   fglInternalFormat := GL_RGBA2;
3190 end;
3191
3192 constructor TfdRGBA4.Create;
3193 begin
3194   inherited Create;
3195   fFormat           := tfRGBA4;
3196   fWithAlpha        := tfRGBA4;
3197   fWithoutAlpha     := tfRGB4;
3198   fRGBInverted      := tfBGRA4;
3199   fRange.r          := $F;
3200   fRange.g          := $F;
3201   fRange.b          := $F;
3202   fRange.a          := $F;
3203   fShift.r          :=  0;
3204   fShift.g          :=  4;
3205   fShift.b          :=  8;
3206   fShift.a          := 12;
3207   fglFormat         := GL_RGBA;
3208   fglInternalFormat := GL_RGBA4;
3209   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3210 end;
3211
3212 constructor TfdRGB5A1.Create;
3213 begin
3214   inherited Create;
3215   fFormat           := tfRGB5A1;
3216   fWithAlpha        := tfRGB5A1;
3217   fWithoutAlpha     := tfRGB5;
3218   fRGBInverted      := tfBGR5A1;
3219   fRange.r          := $1F;
3220   fRange.g          := $1F;
3221   fRange.b          := $1F;
3222   fRange.a          := $01;
3223   fShift.r          :=   0;
3224   fShift.g          :=   5;
3225   fShift.b          :=  10;
3226   fShift.a          :=  15;
3227   fglFormat         := GL_RGBA;
3228   fglInternalFormat := GL_RGB5_A1;
3229   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3230 end;
3231
3232 constructor TfdRGBA8.Create;
3233 begin
3234   inherited Create;
3235   fFormat           := tfRGBA8;
3236   fWithAlpha        := tfRGBA8;
3237   fWithoutAlpha     := tfRGB8;
3238   fRGBInverted      := tfBGRA8;
3239   fglInternalFormat := GL_RGBA8;
3240 end;
3241
3242 constructor TfdRGB10A2.Create;
3243 begin
3244   inherited Create;
3245   fFormat           := tfRGB10A2;
3246   fWithAlpha        := tfRGB10A2;
3247   fWithoutAlpha     := tfRGB10;
3248   fRGBInverted      := tfBGR10A2;
3249   fRange.r          := $3FF;
3250   fRange.g          := $3FF;
3251   fRange.b          := $3FF;
3252   fRange.a          := $003;
3253   fShift.r          :=    0;
3254   fShift.g          :=   10;
3255   fShift.b          :=   20;
3256   fShift.a          :=   30;
3257   fglFormat         := GL_RGBA;
3258   fglInternalFormat := GL_RGB10_A2;
3259   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3260 end;
3261
3262 constructor TfdRGBA12.Create;
3263 begin
3264   inherited Create;
3265   fFormat           := tfRGBA12;
3266   fWithAlpha        := tfRGBA12;
3267   fWithoutAlpha     := tfRGB12;
3268   fRGBInverted      := tfBGRA12;
3269   fglInternalFormat := GL_RGBA12;
3270 end;
3271
3272 constructor TfdRGBA16.Create;
3273 begin
3274   inherited Create;
3275   fFormat           := tfRGBA16;
3276   fWithAlpha        := tfRGBA16;
3277   fWithoutAlpha     := tfRGB16;
3278   fRGBInverted      := tfBGRA16;
3279   fglInternalFormat := GL_RGBA16;
3280 end;
3281
3282 constructor TfdBGR4.Create;
3283 begin
3284   inherited Create;
3285   fPixelSize        := 2.0;
3286   fFormat           := tfBGR4;
3287   fWithAlpha        := tfBGRA4;
3288   fWithoutAlpha     := tfBGR4;
3289   fRGBInverted      := tfRGB4;
3290   fRange.r          := $F;
3291   fRange.g          := $F;
3292   fRange.b          := $F;
3293   fRange.a          := $0;
3294   fShift.r          :=  8;
3295   fShift.g          :=  4;
3296   fShift.b          :=  0;
3297   fShift.a          :=  0;
3298   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3299   fglInternalFormat := GL_RGB4;
3300   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3301 end;
3302
3303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3304 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3305 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3306 constructor TfdB5G6R5.Create;
3307 begin
3308   inherited Create;
3309   fFormat           := tfB5G6R5;
3310   fWithAlpha        := tfBGRA4;
3311   fWithoutAlpha     := tfB5G6R5;
3312   fRGBInverted      := tfR5G6B5;
3313   fRange.r          := $1F;
3314   fRange.g          := $3F;
3315   fRange.b          := $1F;
3316   fShift.r          :=  11;
3317   fShift.g          :=   5;
3318   fShift.b          :=   0;
3319   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3320   fglInternalFormat := GL_RGB8;
3321   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3322 end;
3323
3324 constructor TfdBGR5.Create;
3325 begin
3326   inherited Create;
3327   fPixelSize        := 2.0;
3328   fFormat           := tfBGR5;
3329   fWithAlpha        := tfBGR5A1;
3330   fWithoutAlpha     := tfBGR5;
3331   fRGBInverted      := tfRGB5;
3332   fRange.r          := $1F;
3333   fRange.g          := $1F;
3334   fRange.b          := $1F;
3335   fRange.a          := $00;
3336   fShift.r          :=  10;
3337   fShift.g          :=   5;
3338   fShift.b          :=   0;
3339   fShift.a          :=   0;
3340   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3341   fglInternalFormat := GL_RGB5;
3342   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3343 end;
3344
3345 constructor TfdBGR8.Create;
3346 begin
3347   inherited Create;
3348   fFormat           := tfBGR8;
3349   fWithAlpha        := tfBGRA8;
3350   fWithoutAlpha     := tfBGR8;
3351   fRGBInverted      := tfRGB8;
3352   fglInternalFormat := GL_RGB8;
3353 end;
3354
3355 constructor TfdBGR10.Create;
3356 begin
3357   inherited Create;
3358   fFormat           := tfBGR10;
3359   fWithAlpha        := tfBGR10A2;
3360   fWithoutAlpha     := tfBGR10;
3361   fRGBInverted      := tfRGB10;
3362   fRange.r          := $3FF;
3363   fRange.g          := $3FF;
3364   fRange.b          := $3FF;
3365   fRange.a          := $000;
3366   fShift.r          :=   20;
3367   fShift.g          :=   10;
3368   fShift.b          :=    0;
3369   fShift.a          :=    0;
3370   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3371   fglInternalFormat := GL_RGB10;
3372   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3373 end;
3374
3375 constructor TfdBGR12.Create;
3376 begin
3377   inherited Create;
3378   fFormat           := tfBGR12;
3379   fWithAlpha        := tfBGRA12;
3380   fWithoutAlpha     := tfBGR12;
3381   fRGBInverted      := tfRGB12;
3382   fglInternalFormat := GL_RGB12;
3383 end;
3384
3385 constructor TfdBGR16.Create;
3386 begin
3387   inherited Create;
3388   fFormat           := tfBGR16;
3389   fWithAlpha        := tfBGRA16;
3390   fWithoutAlpha     := tfBGR16;
3391   fRGBInverted      := tfRGB16;
3392   fglInternalFormat := GL_RGB16;
3393 end;
3394
3395 constructor TfdBGRA2.Create;
3396 begin
3397   inherited Create;
3398   fFormat           := tfBGRA2;
3399   fWithAlpha        := tfBGRA4;
3400   fWithoutAlpha     := tfBGR4;
3401   fRGBInverted      := tfRGBA2;
3402   fglInternalFormat := GL_RGBA2;
3403 end;
3404
3405 constructor TfdBGRA4.Create;
3406 begin
3407   inherited Create;
3408   fFormat           := tfBGRA4;
3409   fWithAlpha        := tfBGRA4;
3410   fWithoutAlpha     := tfBGR4;
3411   fRGBInverted      := tfRGBA4;
3412   fRange.r          := $F;
3413   fRange.g          := $F;
3414   fRange.b          := $F;
3415   fRange.a          := $F;
3416   fShift.r          :=  8;
3417   fShift.g          :=  4;
3418   fShift.b          :=  0;
3419   fShift.a          := 12;
3420   fglFormat         := GL_BGRA;
3421   fglInternalFormat := GL_RGBA4;
3422   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3423 end;
3424
3425 constructor TfdBGR5A1.Create;
3426 begin
3427   inherited Create;
3428   fFormat           := tfBGR5A1;
3429   fWithAlpha        := tfBGR5A1;
3430   fWithoutAlpha     := tfBGR5;
3431   fRGBInverted      := tfRGB5A1;
3432   fRange.r          := $1F;
3433   fRange.g          := $1F;
3434   fRange.b          := $1F;
3435   fRange.a          := $01;
3436   fShift.r          :=  10;
3437   fShift.g          :=   5;
3438   fShift.b          :=   0;
3439   fShift.a          :=  15;
3440   fglFormat         := GL_BGRA;
3441   fglInternalFormat := GL_RGB5_A1;
3442   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3443 end;
3444
3445 constructor TfdBGRA8.Create;
3446 begin
3447   inherited Create;
3448   fFormat           := tfBGRA8;
3449   fWithAlpha        := tfBGRA8;
3450   fWithoutAlpha     := tfBGR8;
3451   fRGBInverted      := tfRGBA8;
3452   fglInternalFormat := GL_RGBA8;
3453 end;
3454
3455 constructor TfdBGR10A2.Create;
3456 begin
3457   inherited Create;
3458   fFormat           := tfBGR10A2;
3459   fWithAlpha        := tfBGR10A2;
3460   fWithoutAlpha     := tfBGR10;
3461   fRGBInverted      := tfRGB10A2;
3462   fRange.r          := $3FF;
3463   fRange.g          := $3FF;
3464   fRange.b          := $3FF;
3465   fRange.a          := $003;
3466   fShift.r          :=   20;
3467   fShift.g          :=   10;
3468   fShift.b          :=    0;
3469   fShift.a          :=   30;
3470   fglFormat         := GL_BGRA;
3471   fglInternalFormat := GL_RGB10_A2;
3472   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3473 end;
3474
3475 constructor TfdBGRA12.Create;
3476 begin
3477   inherited Create;
3478   fFormat           := tfBGRA12;
3479   fWithAlpha        := tfBGRA12;
3480   fWithoutAlpha     := tfBGR12;
3481   fRGBInverted      := tfRGBA12;
3482   fglInternalFormat := GL_RGBA12;
3483 end;
3484
3485 constructor TfdBGRA16.Create;
3486 begin
3487   inherited Create;
3488   fFormat           := tfBGRA16;
3489   fWithAlpha        := tfBGRA16;
3490   fWithoutAlpha     := tfBGR16;
3491   fRGBInverted      := tfRGBA16;
3492   fglInternalFormat := GL_RGBA16;
3493 end;
3494
3495 constructor TfdDepth16.Create;
3496 begin
3497   inherited Create;
3498   fFormat           := tfDepth16;
3499   fWithAlpha        := tfEmpty;
3500   fWithoutAlpha     := tfDepth16;
3501   fglInternalFormat := GL_DEPTH_COMPONENT16;
3502 end;
3503
3504 constructor TfdDepth24.Create;
3505 begin
3506   inherited Create;
3507   fFormat           := tfDepth24;
3508   fWithAlpha        := tfEmpty;
3509   fWithoutAlpha     := tfDepth24;
3510   fglInternalFormat := GL_DEPTH_COMPONENT24;
3511 end;
3512
3513 constructor TfdDepth32.Create;
3514 begin
3515   inherited Create;
3516   fFormat           := tfDepth32;
3517   fWithAlpha        := tfEmpty;
3518   fWithoutAlpha     := tfDepth32;
3519   fglInternalFormat := GL_DEPTH_COMPONENT32;
3520 end;
3521
3522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3523 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3524 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3525 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3526 begin
3527   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3528 end;
3529
3530 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3531 begin
3532   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3533 end;
3534
3535 constructor TfdS3tcDtx1RGBA.Create;
3536 begin
3537   inherited Create;
3538   fFormat           := tfS3tcDtx1RGBA;
3539   fWithAlpha        := tfS3tcDtx1RGBA;
3540   fUncompressed     := tfRGB5A1;
3541   fPixelSize        := 0.5;
3542   fIsCompressed     := true;
3543   fglFormat         := GL_COMPRESSED_RGBA;
3544   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3545   fglDataFormat     := GL_UNSIGNED_BYTE;
3546 end;
3547
3548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3549 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3550 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3551 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3552 begin
3553   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3554 end;
3555
3556 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3557 begin
3558   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3559 end;
3560
3561 constructor TfdS3tcDtx3RGBA.Create;
3562 begin
3563   inherited Create;
3564   fFormat           := tfS3tcDtx3RGBA;
3565   fWithAlpha        := tfS3tcDtx3RGBA;
3566   fUncompressed     := tfRGBA8;
3567   fPixelSize        := 1.0;
3568   fIsCompressed     := true;
3569   fglFormat         := GL_COMPRESSED_RGBA;
3570   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3571   fglDataFormat     := GL_UNSIGNED_BYTE;
3572 end;
3573
3574 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3575 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3576 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3577 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3578 begin
3579   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3580 end;
3581
3582 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3583 begin
3584   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3585 end;
3586
3587 constructor TfdS3tcDtx5RGBA.Create;
3588 begin
3589   inherited Create;
3590   fFormat           := tfS3tcDtx3RGBA;
3591   fWithAlpha        := tfS3tcDtx3RGBA;
3592   fUncompressed     := tfRGBA8;
3593   fPixelSize        := 1.0;
3594   fIsCompressed     := true;
3595   fglFormat         := GL_COMPRESSED_RGBA;
3596   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3597   fglDataFormat     := GL_UNSIGNED_BYTE;
3598 end;
3599
3600 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3601 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3603 class procedure TFormatDescriptor.Init;
3604 begin
3605   if not Assigned(FormatDescriptorCS) then
3606     FormatDescriptorCS := TCriticalSection.Create;
3607 end;
3608
3609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3610 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3611 begin
3612   FormatDescriptorCS.Enter;
3613   try
3614     result := FormatDescriptors[aFormat];
3615     if not Assigned(result) then begin
3616       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3617       FormatDescriptors[aFormat] := result;
3618     end;
3619   finally
3620     FormatDescriptorCS.Leave;
3621   end;
3622 end;
3623
3624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3625 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3626 begin
3627   result := Get(Get(aFormat).WithAlpha);
3628 end;
3629
3630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3631 class procedure TFormatDescriptor.Clear;
3632 var
3633   f: TglBitmapFormat;
3634 begin
3635   FormatDescriptorCS.Enter;
3636   try
3637     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3638       FreeAndNil(FormatDescriptors[f]);
3639   finally
3640     FormatDescriptorCS.Leave;
3641   end;
3642 end;
3643
3644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3645 class procedure TFormatDescriptor.Finalize;
3646 begin
3647   Clear;
3648   FreeAndNil(FormatDescriptorCS);
3649 end;
3650
3651 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3652 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3654 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3655 begin
3656   Update(aValue, fRange.r, fShift.r);
3657 end;
3658
3659 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3660 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3661 begin
3662   Update(aValue, fRange.g, fShift.g);
3663 end;
3664
3665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3666 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3667 begin
3668   Update(aValue, fRange.b, fShift.b);
3669 end;
3670
3671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3672 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3673 begin
3674   Update(aValue, fRange.a, fShift.a);
3675 end;
3676
3677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3678 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3679   aShift: Byte);
3680 begin
3681   aShift := 0;
3682   aRange := 0;
3683   if (aMask = 0) then
3684     exit;
3685   while (aMask > 0) and ((aMask and 1) = 0) do begin
3686     inc(aShift);
3687     aMask := aMask shr 1;
3688   end;
3689   aRange := 1;
3690   while (aMask > 0) do begin
3691     aRange := aRange shl 1;
3692     aMask  := aMask  shr 1;
3693   end;
3694   dec(aRange);
3695
3696   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3697 end;
3698
3699 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3700 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3701 var
3702   data: QWord;
3703   s: Integer;
3704 begin
3705   data :=
3706     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3707     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3708     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3709     ((aPixel.Data.a and fRange.a) shl fShift.a);
3710   s := Round(fPixelSize);
3711   case s of
3712     1:           aData^  := data;
3713     2:     PWord(aData)^ := data;
3714     4: PCardinal(aData)^ := data;
3715     8:    PQWord(aData)^ := data;
3716   else
3717     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3718   end;
3719   inc(aData, s);
3720 end;
3721
3722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3723 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3724 var
3725   data: QWord;
3726   s, i: Integer;
3727 begin
3728   s := Round(fPixelSize);
3729   case s of
3730     1: data :=           aData^;
3731     2: data :=     PWord(aData)^;
3732     4: data := PCardinal(aData)^;
3733     8: data :=    PQWord(aData)^;
3734   else
3735     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3736   end;
3737   for i := 0 to 3 do
3738     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3739   inc(aData, s);
3740 end;
3741
3742 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3743 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3745 procedure TbmpColorTableFormat.CreateColorTable;
3746 var
3747   i: Integer;
3748 begin
3749   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3750     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3751
3752   if (Format = tfLuminance4) then
3753     SetLength(fColorTable, 16)
3754   else
3755     SetLength(fColorTable, 256);
3756
3757   case Format of
3758     tfLuminance4: begin
3759       for i := 0 to High(fColorTable) do begin
3760         fColorTable[i].r := 16 * i;
3761         fColorTable[i].g := 16 * i;
3762         fColorTable[i].b := 16 * i;
3763         fColorTable[i].a := 0;
3764       end;
3765     end;
3766
3767     tfLuminance8: begin
3768       for i := 0 to High(fColorTable) do begin
3769         fColorTable[i].r := i;
3770         fColorTable[i].g := i;
3771         fColorTable[i].b := i;
3772         fColorTable[i].a := 0;
3773       end;
3774     end;
3775
3776     tfR3G3B2: begin
3777       for i := 0 to High(fColorTable) do begin
3778         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3779         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3780         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3781         fColorTable[i].a := 0;
3782       end;
3783     end;
3784   end;
3785 end;
3786
3787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3788 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3789 var
3790   d: Byte;
3791 begin
3792   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3793     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3794
3795   case Format of
3796     tfLuminance4: begin
3797       if (aMapData = nil) then
3798         aData^ := 0;
3799       d := LuminanceWeight(aPixel) and Range.r;
3800       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3801       inc(aMapData, 4);
3802       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3803         inc(aData);
3804         aMapData := nil;
3805       end;
3806     end;
3807
3808     tfLuminance8: begin
3809       aData^ := LuminanceWeight(aPixel) and Range.r;
3810       inc(aData);
3811     end;
3812
3813     tfR3G3B2: begin
3814       aData^ := Round(
3815         ((aPixel.Data.r and Range.r) shl Shift.r) or
3816         ((aPixel.Data.g and Range.g) shl Shift.g) or
3817         ((aPixel.Data.b and Range.b) shl Shift.b));
3818       inc(aData);
3819     end;
3820   end;
3821 end;
3822
3823 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3824 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3825 var
3826   idx: QWord;
3827   s: Integer;
3828   bits: Byte;
3829   f: Single;
3830 begin
3831   s    := Trunc(fPixelSize);
3832   f    := fPixelSize - s;
3833   bits := Round(8 * f);
3834   case s of
3835     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3836     1: idx :=           aData^;
3837     2: idx :=     PWord(aData)^;
3838     4: idx := PCardinal(aData)^;
3839     8: idx :=    PQWord(aData)^;
3840   else
3841     raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3842   end;
3843   if (idx >= Length(fColorTable)) then
3844     raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
3845   with fColorTable[idx] do begin
3846     aPixel.Data.r := r;
3847     aPixel.Data.g := g;
3848     aPixel.Data.b := b;
3849     aPixel.Data.a := a;
3850   end;
3851   inc(aMapData, bits);
3852   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3853     inc(aData, 1);
3854     dec(aMapData, 8);
3855   end;
3856   inc(aData, s);
3857 end;
3858
3859 destructor TbmpColorTableFormat.Destroy;
3860 begin
3861   SetLength(fColorTable, 0);
3862   inherited Destroy;
3863 end;
3864
3865 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3866 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3867 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3868 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3869 var
3870   i: Integer;
3871 begin
3872   for i := 0 to 3 do begin
3873     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3874       if (aSourceFD.Range.arr[i] > 0) then
3875         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3876       else
3877         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3878     end;
3879   end;
3880 end;
3881
3882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3883 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3884 begin
3885   with aFuncRec do begin
3886     if (Source.Range.r   > 0) then
3887       Dest.Data.r := Source.Data.r;
3888     if (Source.Range.g > 0) then
3889       Dest.Data.g := Source.Data.g;
3890     if (Source.Range.b  > 0) then
3891       Dest.Data.b := Source.Data.b;
3892     if (Source.Range.a > 0) then
3893       Dest.Data.a := Source.Data.a;
3894   end;
3895 end;
3896
3897 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3898 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3899 var
3900   i: Integer;
3901 begin
3902   with aFuncRec do begin
3903     for i := 0 to 3 do
3904       if (Source.Range.arr[i] > 0) then
3905         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
3906   end;
3907 end;
3908
3909 type
3910   TShiftData = packed record
3911     case Integer of
3912       0: (r, g, b, a: SmallInt);
3913       1: (arr: array[0..3] of SmallInt);
3914   end;
3915   PShiftData = ^TShiftData;
3916
3917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3918 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3919 var
3920   i: Integer;
3921 begin
3922   with aFuncRec do
3923     for i := 0 to 3 do
3924       if (Source.Range.arr[i] > 0) then
3925         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
3926 end;
3927
3928 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3929 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
3930 begin
3931   with aFuncRec do begin
3932     Dest.Data := Source.Data;
3933     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
3934       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
3935       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
3936       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
3937     end;
3938     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
3939       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
3940     end;
3941   end;
3942 end;
3943
3944 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3945 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
3946 var
3947   i: Integer;
3948 begin
3949   with aFuncRec do begin
3950     for i := 0 to 3 do
3951       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
3952   end;
3953 end;
3954
3955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3956 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3957 var
3958   Temp: Single;
3959 begin
3960   with FuncRec do begin
3961     if (FuncRec.Args = nil) then begin //source has no alpha
3962       Temp :=
3963         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
3964         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
3965         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
3966       Dest.Data.a := Round(Dest.Range.a * Temp);
3967     end else
3968       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
3969   end;
3970 end;
3971
3972 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3973 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3974 type
3975   PglBitmapPixelData = ^TglBitmapPixelData;
3976 begin
3977   with FuncRec do begin
3978     Dest.Data.r := Source.Data.r;
3979     Dest.Data.g := Source.Data.g;
3980     Dest.Data.b := Source.Data.b;
3981
3982     with PglBitmapPixelData(Args)^ do
3983       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
3984           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
3985           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
3986         Dest.Data.a := 0
3987       else
3988         Dest.Data.a := Dest.Range.a;
3989   end;
3990 end;
3991
3992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3993 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3994 begin
3995   with FuncRec do begin
3996     Dest.Data.r := Source.Data.r;
3997     Dest.Data.g := Source.Data.g;
3998     Dest.Data.b := Source.Data.b;
3999     Dest.Data.a := PCardinal(Args)^;
4000   end;
4001 end;
4002
4003 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4004 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4005 type
4006   PRGBPix = ^TRGBPix;
4007   TRGBPix = array [0..2] of byte;
4008 var
4009   Temp: Byte;
4010 begin
4011   while aWidth > 0 do begin
4012     Temp := PRGBPix(aData)^[0];
4013     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4014     PRGBPix(aData)^[2] := Temp;
4015
4016     if aHasAlpha then
4017       Inc(aData, 4)
4018     else
4019       Inc(aData, 3);
4020     dec(aWidth);
4021   end;
4022 end;
4023
4024 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4025 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4026 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4027 function TglBitmap.GetWidth: Integer;
4028 begin
4029   if (ffX in fDimension.Fields) then
4030     result := fDimension.X
4031   else
4032     result := -1;
4033 end;
4034
4035 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4036 function TglBitmap.GetHeight: Integer;
4037 begin
4038   if (ffY in fDimension.Fields) then
4039     result := fDimension.Y
4040   else
4041     result := -1;
4042 end;
4043
4044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4045 function TglBitmap.GetFileWidth: Integer;
4046 begin
4047   result := Max(1, Width);
4048 end;
4049
4050 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4051 function TglBitmap.GetFileHeight: Integer;
4052 begin
4053   result := Max(1, Height);
4054 end;
4055
4056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4057 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4058 begin
4059   if fCustomData = aValue then
4060     exit;
4061   fCustomData := aValue;
4062 end;
4063
4064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4065 procedure TglBitmap.SetCustomName(const aValue: String);
4066 begin
4067   if fCustomName = aValue then
4068     exit;
4069   fCustomName := aValue;
4070 end;
4071
4072 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4073 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4074 begin
4075   if fCustomNameW = aValue then
4076     exit;
4077   fCustomNameW := aValue;
4078 end;
4079
4080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4081 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4082 begin
4083   if fDeleteTextureOnFree = aValue then
4084     exit;
4085   fDeleteTextureOnFree := aValue;
4086 end;
4087
4088 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4089 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4090 begin
4091   if fFormat = aValue then
4092     exit;
4093   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4094     raise EglBitmapUnsupportedFormat.Create(Format);
4095   SetDataPointer(Data, aValue, Width, Height);
4096 end;
4097
4098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4099 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4100 begin
4101   if fFreeDataAfterGenTexture = aValue then
4102     exit;
4103   fFreeDataAfterGenTexture := aValue;
4104 end;
4105
4106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4107 procedure TglBitmap.SetID(const aValue: Cardinal);
4108 begin
4109   if fID = aValue then
4110     exit;
4111   fID := aValue;
4112 end;
4113
4114 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4115 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4116 begin
4117   if fMipMap = aValue then
4118     exit;
4119   fMipMap := aValue;
4120 end;
4121
4122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4123 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4124 begin
4125   if fTarget = aValue then
4126     exit;
4127   fTarget := aValue;
4128 end;
4129
4130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4131 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4132 var
4133   MaxAnisotropic: Integer;
4134 begin
4135   fAnisotropic := aValue;
4136   if (ID > 0) then begin
4137     if GL_EXT_texture_filter_anisotropic then begin
4138       if fAnisotropic > 0 then begin
4139         Bind(false);
4140         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4141         if aValue > MaxAnisotropic then
4142           fAnisotropic := MaxAnisotropic;
4143         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4144       end;
4145     end else begin
4146       fAnisotropic := 0;
4147     end;
4148   end;
4149 end;
4150
4151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4152 procedure TglBitmap.CreateID;
4153 begin
4154   if (ID <> 0) then
4155     glDeleteTextures(1, @fID);
4156   glGenTextures(1, @fID);
4157   Bind(false);
4158 end;
4159
4160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4161 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4162 begin
4163   // Set Up Parameters
4164   SetWrap(fWrapS, fWrapT, fWrapR);
4165   SetFilter(fFilterMin, fFilterMag);
4166   SetAnisotropic(fAnisotropic);
4167   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4168
4169   // Mip Maps Generation Mode
4170   aBuildWithGlu := false;
4171   if (MipMap = mmMipmap) then begin
4172     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4173       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4174     else
4175       aBuildWithGlu := true;
4176   end else if (MipMap = mmMipmapGlu) then
4177     aBuildWithGlu := true;
4178 end;
4179
4180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4181 procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
4182   const aWidth: Integer; const aHeight: Integer);
4183 var
4184   s: Single;
4185 begin
4186   if (Data <> aData) then begin
4187     if (Assigned(Data)) then
4188       FreeMem(Data);
4189     fData := aData;
4190   end;
4191
4192   FillChar(fDimension, SizeOf(fDimension), 0);
4193   if not Assigned(fData) then begin
4194     fFormat    := tfEmpty;
4195     fPixelSize := 0;
4196     fRowSize   := 0;
4197   end else begin
4198     if aWidth <> -1 then begin
4199       fDimension.Fields := fDimension.Fields + [ffX];
4200       fDimension.X := aWidth;
4201     end;
4202
4203     if aHeight <> -1 then begin
4204       fDimension.Fields := fDimension.Fields + [ffY];
4205       fDimension.Y := aHeight;
4206     end;
4207
4208     s := TFormatDescriptor.Get(aFormat).PixelSize;
4209     fFormat    := aFormat;
4210     fPixelSize := Ceil(s);
4211     fRowSize   := Ceil(s * aWidth);
4212   end;
4213 end;
4214
4215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4216 function TglBitmap.FlipHorz: Boolean;
4217 begin
4218   result := false;
4219 end;
4220
4221 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4222 function TglBitmap.FlipVert: Boolean;
4223 begin
4224   result := false;
4225 end;
4226
4227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4228 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4229 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4230 procedure TglBitmap.AfterConstruction;
4231 begin
4232   inherited AfterConstruction;
4233
4234   fID         := 0;
4235   fTarget     := 0;
4236   fIsResident := false;
4237
4238   fFormat                  := glBitmapGetDefaultFormat;
4239   fMipMap                  := glBitmapDefaultMipmap;
4240   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4241   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4242
4243   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4244   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4245 end;
4246
4247 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4248 procedure TglBitmap.BeforeDestruction;
4249 begin
4250   SetDataPointer(nil, tfEmpty);
4251   if (fID > 0) and fDeleteTextureOnFree then
4252     glDeleteTextures(1, @fID);
4253   inherited BeforeDestruction;
4254 end;
4255
4256 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4257 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4258 var
4259   TempPos: Integer;
4260 begin
4261   if not Assigned(aResType) then begin
4262     TempPos   := Pos('.', aResource);
4263     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4264     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4265   end;
4266 end;
4267
4268 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4269 procedure TglBitmap.LoadFromFile(const aFilename: String);
4270 var
4271   fs: TFileStream;
4272 begin
4273   if not FileExists(aFilename) then
4274     raise EglBitmapException.Create('file does not exist: ' + aFilename);
4275   fFilename := aFilename;
4276   fs := TFileStream.Create(fFilename, fmOpenRead);
4277   try
4278     fs.Position := 0;
4279     LoadFromStream(fs);
4280   finally
4281     fs.Free;
4282   end;
4283 end;
4284
4285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4286 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4287 begin
4288   {$IFDEF GLB_SUPPORT_PNG_READ}
4289   if not LoadPNG(aStream) then
4290   {$ENDIF}
4291   {$IFDEF GLB_SUPPORT_JPEG_READ}
4292   if not LoadJPEG(aStream) then
4293   {$ENDIF}
4294   if not LoadDDS(aStream) then
4295   if not LoadTGA(aStream) then
4296   if not LoadBMP(aStream) then
4297     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4298 end;
4299
4300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4301 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4302   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4303 var
4304   tmpData: PByte;
4305   size: Integer;
4306 begin
4307   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4308   GetMem(tmpData, size);
4309   try
4310     FillChar(tmpData^, size, #$FF);
4311     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
4312   except
4313     FreeMem(tmpData);
4314     raise;
4315   end;
4316   AddFunc(Self, aFunc, false, Format, aArgs);
4317 end;
4318
4319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4320 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4321 var
4322   rs: TResourceStream;
4323 begin
4324   PrepareResType(aResource, aResType);
4325   rs := TResourceStream.Create(aInstance, aResource, aResType);
4326   try
4327     LoadFromStream(rs);
4328   finally
4329     rs.Free;
4330   end;
4331 end;
4332
4333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4334 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4335 var
4336   rs: TResourceStream;
4337 begin
4338   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4339   try
4340     LoadFromStream(rs);
4341   finally
4342     rs.Free;
4343   end;
4344 end;
4345
4346 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4347 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4348 var
4349   fs: TFileStream;
4350 begin
4351   fs := TFileStream.Create(aFileName, fmCreate);
4352   try
4353     fs.Position := 0;
4354     SaveToStream(fs, aFileType);
4355   finally
4356     fs.Free;
4357   end;
4358 end;
4359
4360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4361 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4362 begin
4363   case aFileType of
4364     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4365     ftPNG:  SavePNG(aStream);
4366     {$ENDIF}
4367     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4368     ftJPEG: SaveJPEG(aStream);
4369     {$ENDIF}
4370     ftDDS:  SaveDDS(aStream);
4371     ftTGA:  SaveTGA(aStream);
4372     ftBMP:  SaveBMP(aStream);
4373   end;
4374 end;
4375
4376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4377 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4378 begin
4379   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4380 end;
4381
4382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4383 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4384   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4385 var
4386   DestData, TmpData, SourceData: pByte;
4387   TempHeight, TempWidth: Integer;
4388   SourceFD, DestFD: TFormatDescriptor;
4389   SourceMD, DestMD: Pointer;
4390
4391   FuncRec: TglBitmapFunctionRec;
4392 begin
4393   Assert(Assigned(Data));
4394   Assert(Assigned(aSource));
4395   Assert(Assigned(aSource.Data));
4396
4397   result := false;
4398   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4399     SourceFD := TFormatDescriptor.Get(aSource.Format);
4400     DestFD   := TFormatDescriptor.Get(aFormat);
4401
4402     if (SourceFD.IsCompressed) then
4403       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4404     if (DestFD.IsCompressed) then
4405       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4406
4407     // inkompatible Formats so CreateTemp
4408     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4409       aCreateTemp := true;
4410
4411     // Values
4412     TempHeight := Max(1, aSource.Height);
4413     TempWidth  := Max(1, aSource.Width);
4414
4415     FuncRec.Sender := Self;
4416     FuncRec.Args   := aArgs;
4417
4418     TmpData := nil;
4419     if aCreateTemp then begin
4420       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4421       DestData := TmpData;
4422     end else
4423       DestData := Data;
4424
4425     try
4426       SourceFD.PreparePixel(FuncRec.Source);
4427       DestFD.PreparePixel  (FuncRec.Dest);
4428
4429       SourceMD := SourceFD.CreateMappingData;
4430       DestMD   := DestFD.CreateMappingData;
4431
4432       FuncRec.Size            := aSource.Dimension;
4433       FuncRec.Position.Fields := FuncRec.Size.Fields;
4434
4435       try
4436         SourceData := aSource.Data;
4437         FuncRec.Position.Y := 0;
4438         while FuncRec.Position.Y < TempHeight do begin
4439           FuncRec.Position.X := 0;
4440           while FuncRec.Position.X < TempWidth do begin
4441             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4442             aFunc(FuncRec);
4443             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4444             inc(FuncRec.Position.X);
4445           end;
4446           inc(FuncRec.Position.Y);
4447         end;
4448
4449         // Updating Image or InternalFormat
4450         if aCreateTemp then
4451           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
4452         else if (aFormat <> fFormat) then
4453           Format := aFormat;
4454
4455         result := true;
4456       finally
4457         SourceFD.FreeMappingData(SourceMD);
4458         DestFD.FreeMappingData(DestMD);
4459       end;
4460     except
4461       if aCreateTemp then
4462         FreeMem(TmpData);
4463       raise;
4464     end;
4465   end;
4466 end;
4467
4468 {$IFDEF GLB_SDL}
4469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4470 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4471 var
4472   Row, RowSize: Integer;
4473   SourceData, TmpData: PByte;
4474   TempDepth: Integer;
4475   FormatDesc: TFormatDescriptor;
4476
4477   function GetRowPointer(Row: Integer): pByte;
4478   begin
4479     result := aSurface.pixels;
4480     Inc(result, Row * RowSize);
4481   end;
4482
4483 begin
4484   result := false;
4485
4486   FormatDesc := TFormatDescriptor.Get(Format);
4487   if FormatDesc.IsCompressed then
4488     raise EglBitmapUnsupportedFormat.Create(Format);
4489
4490   if Assigned(Data) then begin
4491     case Trunc(FormatDesc.PixelSize) of
4492       1: TempDepth :=  8;
4493       2: TempDepth := 16;
4494       3: TempDepth := 24;
4495       4: TempDepth := 32;
4496     else
4497       raise EglBitmapUnsupportedFormat.Create(Format);
4498     end;
4499
4500     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4501       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4502     SourceData := Data;
4503     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4504
4505     for Row := 0 to FileHeight-1 do begin
4506       TmpData := GetRowPointer(Row);
4507       if Assigned(TmpData) then begin
4508         Move(SourceData^, TmpData^, RowSize);
4509         inc(SourceData, RowSize);
4510       end;
4511     end;
4512     result := true;
4513   end;
4514 end;
4515
4516 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4517 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4518 var
4519   pSource, pData, pTempData: PByte;
4520   Row, RowSize, TempWidth, TempHeight: Integer;
4521   IntFormat: TglBitmapFormat;
4522   FormatDesc: TFormatDescriptor;
4523
4524   function GetRowPointer(Row: Integer): pByte;
4525   begin
4526     result := aSurface^.pixels;
4527     Inc(result, Row * RowSize);
4528   end;
4529
4530 begin
4531   result := false;
4532   if (Assigned(aSurface)) then begin
4533     with aSurface^.format^ do begin
4534       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4535         FormatDesc := TFormatDescriptor.Get(IntFormat);
4536         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4537           break;
4538       end;
4539       if (IntFormat = tfEmpty) then
4540         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4541     end;
4542
4543     TempWidth  := aSurface^.w;
4544     TempHeight := aSurface^.h;
4545     RowSize := FormatDesc.GetSize(TempWidth, 1);
4546     GetMem(pData, TempHeight * RowSize);
4547     try
4548       pTempData := pData;
4549       for Row := 0 to TempHeight -1 do begin
4550         pSource := GetRowPointer(Row);
4551         if (Assigned(pSource)) then begin
4552           Move(pSource^, pTempData^, RowSize);
4553           Inc(pTempData, RowSize);
4554         end;
4555       end;
4556       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4557       result := true;
4558     except
4559       FreeMem(pData);
4560       raise;
4561     end;
4562   end;
4563 end;
4564
4565 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4566 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4567 var
4568   Row, Col, AlphaInterleave: Integer;
4569   pSource, pDest: PByte;
4570
4571   function GetRowPointer(Row: Integer): pByte;
4572   begin
4573     result := aSurface.pixels;
4574     Inc(result, Row * Width);
4575   end;
4576
4577 begin
4578   result := false;
4579   if Assigned(Data) then begin
4580     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4581       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4582
4583       AlphaInterleave := 0;
4584       case Format of
4585         tfLuminance8Alpha8:
4586           AlphaInterleave := 1;
4587         tfBGRA8, tfRGBA8:
4588           AlphaInterleave := 3;
4589       end;
4590
4591       pSource := Data;
4592       for Row := 0 to Height -1 do begin
4593         pDest := GetRowPointer(Row);
4594         if Assigned(pDest) then begin
4595           for Col := 0 to Width -1 do begin
4596             Inc(pSource, AlphaInterleave);
4597             pDest^ := pSource^;
4598             Inc(pDest);
4599             Inc(pSource);
4600           end;
4601         end;
4602       end;
4603       result := true;
4604     end;
4605   end;
4606 end;
4607
4608 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4609 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4610 var
4611   bmp: TglBitmap2D;
4612 begin
4613   bmp := TglBitmap2D.Create;
4614   try
4615     bmp.AssignFromSurface(aSurface);
4616     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4617   finally
4618     bmp.Free;
4619   end;
4620 end;
4621 {$ENDIF}
4622
4623 {$IFDEF GLB_DELPHI}
4624 //TODO rework & test
4625 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4626 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4627 var
4628   Row: Integer;
4629   pSource, pData: PByte;
4630 begin
4631   result := false;
4632   if Assigned(Data) then begin
4633     if Assigned(aBitmap) then begin
4634       aBitmap.Width  := Width;
4635       aBitmap.Height := Height;
4636
4637       case Format of
4638         tfAlpha8, ifLuminance, ifDepth8:
4639           begin
4640             Bitmap.PixelFormat := pf8bit;
4641             Bitmap.Palette := CreateGrayPalette;
4642           end;
4643         ifRGB5A1:
4644           Bitmap.PixelFormat := pf15bit;
4645         ifR5G6B5:
4646           Bitmap.PixelFormat := pf16bit;
4647         ifRGB8, ifBGR8:
4648           Bitmap.PixelFormat := pf24bit;
4649         ifRGBA8, ifBGRA8:
4650           Bitmap.PixelFormat := pf32bit;
4651         else
4652           raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4653       end;
4654
4655       pSource := Data;
4656       for Row := 0 to FileHeight -1 do begin
4657         pData := Bitmap.Scanline[Row];
4658
4659         Move(pSource^, pData^, fRowSize);
4660         Inc(pSource, fRowSize);
4661
4662         // swap RGB(A) to BGR(A)
4663         if InternalFormat in [ifRGB8, ifRGBA8] then
4664           SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
4665       end;
4666
4667       result := true;
4668     end;
4669   end;
4670 end;
4671
4672 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4673 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4674 var
4675   pSource, pData, pTempData: PByte;
4676   Row, RowSize, TempWidth, TempHeight: Integer;
4677   IntFormat: TglBitmapInternalFormat;
4678 begin
4679   result := false;
4680
4681   if (Assigned(Bitmap)) then begin
4682     case Bitmap.PixelFormat of
4683       pf8bit:
4684         IntFormat := ifLuminance;
4685       pf15bit:
4686         IntFormat := ifRGB5A1;
4687       pf16bit:
4688         IntFormat := ifR5G6B5;
4689       pf24bit:
4690         IntFormat := ifBGR8;
4691       pf32bit:
4692         IntFormat := ifBGRA8;
4693       else
4694         raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4695     end;
4696
4697     TempWidth := Bitmap.Width;
4698     TempHeight := Bitmap.Height;
4699
4700     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
4701
4702     GetMem(pData, TempHeight * RowSize);
4703     try
4704       pTempData := pData;
4705
4706       for Row := 0 to TempHeight -1 do begin
4707         pSource := Bitmap.Scanline[Row];
4708
4709         if (Assigned(pSource)) then begin
4710           Move(pSource^, pTempData^, RowSize);
4711           Inc(pTempData, RowSize);
4712         end;
4713       end;
4714
4715       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4716
4717       result := true;
4718     except
4719       FreeMem(pData);
4720       raise;
4721     end;
4722   end;
4723 end;
4724
4725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4726 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4727 var
4728   Row, Col, AlphaInterleave: Integer;
4729   pSource, pDest: PByte;
4730 begin
4731   result := false;
4732
4733   if Assigned(Data) then begin
4734     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
4735       if Assigned(Bitmap) then begin
4736         Bitmap.PixelFormat := pf8bit;
4737         Bitmap.Palette := CreateGrayPalette;
4738         Bitmap.Width := Width;
4739         Bitmap.Height := Height;
4740
4741         case InternalFormat of
4742           ifLuminanceAlpha:
4743             AlphaInterleave := 1;
4744           ifRGBA8, ifBGRA8:
4745             AlphaInterleave := 3;
4746           else
4747             AlphaInterleave := 0;
4748         end;
4749
4750         // Copy Data
4751         pSource := Data;
4752
4753         for Row := 0 to Height -1 do begin
4754           pDest := Bitmap.Scanline[Row];
4755
4756           if Assigned(pDest) then begin
4757             for Col := 0 to Width -1 do begin
4758               Inc(pSource, AlphaInterleave);
4759               pDest^ := pSource^;
4760               Inc(pDest);
4761               Inc(pSource);
4762             end;
4763           end;
4764         end;
4765
4766         result := true;
4767       end;
4768     end;
4769   end;
4770 end;
4771
4772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4773 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4774 var
4775   tex: TglBitmap2D;
4776 begin
4777   tex := TglBitmap2D.Create;
4778   try
4779     tex.AssignFromBitmap(Bitmap);
4780     result := AddAlphaFromglBitmap(tex, Func, CustomData);
4781   finally
4782     tex.Free;
4783   end;
4784 end;
4785 {$ENDIF}
4786
4787 {$IFDEF GLB_LAZARUS}
4788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4789 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4790 var
4791   rid: TRawImageDescription;
4792   FormatDesc: TFormatDescriptor;
4793 begin
4794   result := false;
4795   if not Assigned(aImage) or (Format = tfEmpty) then
4796     exit;
4797   FormatDesc := TFormatDescriptor.Get(Format);
4798   if FormatDesc.IsCompressed then
4799     exit;
4800
4801   FillChar(rid{%H-}, SizeOf(rid), 0);
4802   if (Format in [
4803        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4804        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4805        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4806     rid.Format := ricfGray
4807   else
4808     rid.Format := ricfRGBA;
4809
4810   rid.Width        := Width;
4811   rid.Height       := Height;
4812   rid.Depth        := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
4813   rid.BitOrder     := riboBitsInOrder;
4814   rid.ByteOrder    := riboLSBFirst;
4815   rid.LineOrder    := riloTopToBottom;
4816   rid.LineEnd      := rileTight;
4817   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4818   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4819   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4820   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4821   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4822   rid.RedShift     := FormatDesc.Shift.r;
4823   rid.GreenShift   := FormatDesc.Shift.g;
4824   rid.BlueShift    := FormatDesc.Shift.b;
4825   rid.AlphaShift   := FormatDesc.Shift.a;
4826
4827   rid.MaskBitsPerPixel  := 0;
4828   rid.PaletteColorCount := 0;
4829
4830   aImage.DataDescription := rid;
4831   aImage.CreateData;
4832
4833   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4834
4835   result := true;
4836 end;
4837
4838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4839 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4840 var
4841   f: TglBitmapFormat;
4842   FormatDesc: TFormatDescriptor;
4843   ImageData: PByte;
4844   ImageSize: Integer;
4845 begin
4846   result := false;
4847   if not Assigned(aImage) then
4848     exit;
4849   for f := High(f) downto Low(f) do begin
4850     FormatDesc := TFormatDescriptor.Get(f);
4851     with aImage.DataDescription do
4852       if FormatDesc.MaskMatch(
4853         (QWord(1 shl RedPrec  )-1) shl RedShift,
4854         (QWord(1 shl GreenPrec)-1) shl GreenShift,
4855         (QWord(1 shl BluePrec )-1) shl BlueShift,
4856         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
4857         break;
4858   end;
4859
4860   if (f = tfEmpty) then
4861     exit;
4862
4863   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
4864   ImageData := GetMem(ImageSize);
4865   try
4866     Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
4867     SetDataPointer(ImageData, f, aImage.Width, aImage.Height);
4868   except
4869     FreeMem(ImageData);
4870     raise;
4871   end;
4872
4873   result := true;
4874 end;
4875
4876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4877 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4878 var
4879   rid: TRawImageDescription;
4880   FormatDesc: TFormatDescriptor;
4881   Pixel: TglBitmapPixelData;
4882   x, y: Integer;
4883   srcMD: Pointer;
4884   src, dst: PByte;
4885 begin
4886   result := false;
4887   if not Assigned(aImage) or (Format = tfEmpty) then
4888     exit;
4889   FormatDesc := TFormatDescriptor.Get(Format);
4890   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
4891     exit;
4892
4893   FillChar(rid{%H-}, SizeOf(rid), 0);
4894   rid.Format       := ricfGray;
4895   rid.Width        := Width;
4896   rid.Height       := Height;
4897   rid.Depth        := CountSetBits(FormatDesc.Range.a);
4898   rid.BitOrder     := riboBitsInOrder;
4899   rid.ByteOrder    := riboLSBFirst;
4900   rid.LineOrder    := riloTopToBottom;
4901   rid.LineEnd      := rileTight;
4902   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
4903   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
4904   rid.GreenPrec    := 0;
4905   rid.BluePrec     := 0;
4906   rid.AlphaPrec    := 0;
4907   rid.RedShift     := 0;
4908   rid.GreenShift   := 0;
4909   rid.BlueShift    := 0;
4910   rid.AlphaShift   := 0;
4911
4912   rid.MaskBitsPerPixel  := 0;
4913   rid.PaletteColorCount := 0;
4914
4915   aImage.DataDescription := rid;
4916   aImage.CreateData;
4917
4918   srcMD := FormatDesc.CreateMappingData;
4919   try
4920     FormatDesc.PreparePixel(Pixel);
4921     src := Data;
4922     dst := aImage.PixelData;
4923     for y := 0 to Height-1 do
4924       for x := 0 to Width-1 do begin
4925         FormatDesc.Unmap(src, Pixel, srcMD);
4926         case rid.BitsPerPixel of
4927            8: begin
4928             dst^ := Pixel.Data.a;
4929             inc(dst);
4930           end;
4931           16: begin
4932             PWord(dst)^ := Pixel.Data.a;
4933             inc(dst, 2);
4934           end;
4935           24: begin
4936             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
4937             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
4938             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
4939             inc(dst, 3);
4940           end;
4941           32: begin
4942             PCardinal(dst)^ := Pixel.Data.a;
4943             inc(dst, 4);
4944           end;
4945         else
4946           raise EglBitmapUnsupportedFormat.Create(Format);
4947         end;
4948       end;
4949   finally
4950     FormatDesc.FreeMappingData(srcMD);
4951   end;
4952   result := true;
4953 end;
4954
4955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4956 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4957 var
4958   tex: TglBitmap2D;
4959 begin
4960   tex := TglBitmap2D.Create;
4961   try
4962     tex.AssignFromLazIntfImage(aImage);
4963     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4964   finally
4965     tex.Free;
4966   end;
4967 end;
4968 {$ENDIF}
4969
4970 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4971 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
4972   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4973 var
4974   rs: TResourceStream;
4975 begin
4976   PrepareResType(aResource, aResType);
4977   rs := TResourceStream.Create(aInstance, aResource, aResType);
4978   try
4979     result := AddAlphaFromStream(rs, aFunc, aArgs);
4980   finally
4981     rs.Free;
4982   end;
4983 end;
4984
4985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4986 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
4987   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4988 var
4989   rs: TResourceStream;
4990 begin
4991   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4992   try
4993     result := AddAlphaFromStream(rs, aFunc, aArgs);
4994   finally
4995     rs.Free;
4996   end;
4997 end;
4998
4999 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5000 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5001 begin
5002   if TFormatDescriptor.Get(Format).IsCompressed then
5003     raise EglBitmapUnsupportedFormat.Create(Format);
5004   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5005 end;
5006
5007 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5008 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5009 var
5010   FS: TFileStream;
5011 begin
5012   FS := TFileStream.Create(FileName, fmOpenRead);
5013   try
5014     result := AddAlphaFromStream(FS, aFunc, aArgs);
5015   finally
5016     FS.Free;
5017   end;
5018 end;
5019
5020 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5021 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5022 var
5023   tex: TglBitmap2D;
5024 begin
5025   tex := TglBitmap2D.Create(aStream);
5026   try
5027     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5028   finally
5029     tex.Free;
5030   end;
5031 end;
5032
5033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5034 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5035 var
5036   DestData, DestData2, SourceData: pByte;
5037   TempHeight, TempWidth: Integer;
5038   SourceFD, DestFD: TFormatDescriptor;
5039   SourceMD, DestMD, DestMD2: Pointer;
5040
5041   FuncRec: TglBitmapFunctionRec;
5042 begin
5043   result := false;
5044
5045   Assert(Assigned(Data));
5046   Assert(Assigned(aBitmap));
5047   Assert(Assigned(aBitmap.Data));
5048
5049   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5050     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5051
5052     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5053     DestFD   := TFormatDescriptor.Get(Format);
5054
5055     if not Assigned(aFunc) then begin
5056       aFunc        := glBitmapAlphaFunc;
5057       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5058     end else
5059       FuncRec.Args := aArgs;
5060
5061     // Values
5062     TempHeight := aBitmap.FileHeight;
5063     TempWidth  := aBitmap.FileWidth;
5064
5065     FuncRec.Sender          := Self;
5066     FuncRec.Size            := Dimension;
5067     FuncRec.Position.Fields := FuncRec.Size.Fields;
5068
5069     DestData   := Data;
5070     DestData2  := Data;
5071     SourceData := aBitmap.Data;
5072
5073     // Mapping
5074     SourceFD.PreparePixel(FuncRec.Source);
5075     DestFD.PreparePixel  (FuncRec.Dest);
5076
5077     SourceMD := SourceFD.CreateMappingData;
5078     DestMD   := DestFD.CreateMappingData;
5079     DestMD2  := DestFD.CreateMappingData;
5080     try
5081       FuncRec.Position.Y := 0;
5082       while FuncRec.Position.Y < TempHeight do begin
5083         FuncRec.Position.X := 0;
5084         while FuncRec.Position.X < TempWidth do begin
5085           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5086           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5087           aFunc(FuncRec);
5088           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5089           inc(FuncRec.Position.X);
5090         end;
5091         inc(FuncRec.Position.Y);
5092       end;
5093     finally
5094       SourceFD.FreeMappingData(SourceMD);
5095       DestFD.FreeMappingData(DestMD);
5096       DestFD.FreeMappingData(DestMD2);
5097     end;
5098   end;
5099 end;
5100
5101 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5102 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5103 begin
5104   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5105 end;
5106
5107 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5108 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5109 var
5110   PixelData: TglBitmapPixelData;
5111 begin
5112   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5113   result := AddAlphaFromColorKeyFloat(
5114     aRed   / PixelData.Range.r,
5115     aGreen / PixelData.Range.g,
5116     aBlue  / PixelData.Range.b,
5117     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5118 end;
5119
5120 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5121 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5122 var
5123   values: array[0..2] of Single;
5124   tmp: Cardinal;
5125   i: Integer;
5126   PixelData: TglBitmapPixelData;
5127 begin
5128   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5129   with PixelData do begin
5130     values[0] := aRed;
5131     values[1] := aGreen;
5132     values[2] := aBlue;
5133
5134     for i := 0 to 2 do begin
5135       tmp          := Trunc(Range.arr[i] * aDeviation);
5136       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5137       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5138     end;
5139     Data.a  := 0;
5140     Range.a := 0;
5141   end;
5142   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5143 end;
5144
5145 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5146 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5147 begin
5148   result := AddAlphaFromValueFloat(aAlpha / $FF);
5149 end;
5150
5151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5152 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5153 var
5154   PixelData: TglBitmapPixelData;
5155 begin
5156   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5157   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5158 end;
5159
5160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5161 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5162 var
5163   PixelData: TglBitmapPixelData;
5164 begin
5165   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5166   with PixelData do
5167     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5168   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5169 end;
5170
5171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5172 function TglBitmap.RemoveAlpha: Boolean;
5173 var
5174   FormatDesc: TFormatDescriptor;
5175 begin
5176   result := false;
5177   FormatDesc := TFormatDescriptor.Get(Format);
5178   if Assigned(Data) then begin
5179     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5180       raise EglBitmapUnsupportedFormat.Create(Format);
5181     result := ConvertTo(FormatDesc.WithoutAlpha);
5182   end;
5183 end;
5184
5185 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5186 function TglBitmap.Clone: TglBitmap;
5187 var
5188   Temp: TglBitmap;
5189   TempPtr: PByte;
5190   Size: Integer;
5191 begin
5192   result := nil;
5193   Temp := (ClassType.Create as TglBitmap);
5194   try
5195     // copy texture data if assigned
5196     if Assigned(Data) then begin
5197       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5198       GetMem(TempPtr, Size);
5199       try
5200         Move(Data^, TempPtr^, Size);
5201         Temp.SetDataPointer(TempPtr, Format, Width, Height);
5202       except
5203         FreeMem(TempPtr);
5204         raise;
5205       end;
5206     end else
5207       Temp.SetDataPointer(nil, Format, Width, Height);
5208
5209         // copy properties
5210     Temp.fID                      := ID;
5211     Temp.fTarget                  := Target;
5212     Temp.fFormat                  := Format;
5213     Temp.fMipMap                  := MipMap;
5214     Temp.fAnisotropic             := Anisotropic;
5215     Temp.fBorderColor             := fBorderColor;
5216     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5217     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5218     Temp.fFilterMin               := fFilterMin;
5219     Temp.fFilterMag               := fFilterMag;
5220     Temp.fWrapS                   := fWrapS;
5221     Temp.fWrapT                   := fWrapT;
5222     Temp.fWrapR                   := fWrapR;
5223     Temp.fFilename                := fFilename;
5224     Temp.fCustomName              := fCustomName;
5225     Temp.fCustomNameW             := fCustomNameW;
5226     Temp.fCustomData              := fCustomData;
5227
5228     result := Temp;
5229   except
5230     FreeAndNil(Temp);
5231     raise;
5232   end;
5233 end;
5234
5235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5236 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5237 var
5238   SourceFD, DestFD: TFormatDescriptor;
5239   SourcePD, DestPD: TglBitmapPixelData;
5240   ShiftData: TShiftData;
5241
5242   function CanCopyDirect: Boolean;
5243   begin
5244     result :=
5245       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5246       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5247       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5248       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5249   end;
5250
5251   function CanShift: Boolean;
5252   begin
5253     result :=
5254       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5255       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5256       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5257       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5258   end;
5259
5260   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5261   begin
5262     result := 0;
5263     while (aSource > aDest) and (aSource > 0) do begin
5264       inc(result);
5265       aSource := aSource shr 1;
5266     end;
5267   end;
5268
5269 begin
5270   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5271     SourceFD := TFormatDescriptor.Get(Format);
5272     DestFD   := TFormatDescriptor.Get(aFormat);
5273
5274     SourceFD.PreparePixel(SourcePD);
5275     DestFD.PreparePixel  (DestPD);
5276
5277     if CanCopyDirect then
5278       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5279     else if CanShift then begin
5280       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5281       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5282       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5283       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5284       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5285     end else
5286       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5287   end else
5288     result := true;
5289 end;
5290
5291 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5292 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5293 begin
5294   if aUseRGB or aUseAlpha then
5295     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5296       ((PtrInt(aUseAlpha) and 1) shl 1) or
5297        (PtrInt(aUseRGB)   and 1)      ));
5298 end;
5299
5300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5301 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5302 begin
5303   fBorderColor[0] := aRed;
5304   fBorderColor[1] := aGreen;
5305   fBorderColor[2] := aBlue;
5306   fBorderColor[3] := aAlpha;
5307   if (ID > 0) then begin
5308     Bind(false);
5309     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5310   end;
5311 end;
5312
5313 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5314 procedure TglBitmap.FreeData;
5315 begin
5316   SetDataPointer(nil, tfEmpty);
5317 end;
5318
5319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5320 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5321   const aAlpha: Byte);
5322 begin
5323   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5324 end;
5325
5326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5327 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5328 var
5329   PixelData: TglBitmapPixelData;
5330 begin
5331   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5332   FillWithColorFloat(
5333     aRed   / PixelData.Range.r,
5334     aGreen / PixelData.Range.g,
5335     aBlue  / PixelData.Range.b,
5336     aAlpha / PixelData.Range.a);
5337 end;
5338
5339 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5340 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5341 var
5342   PixelData: TglBitmapPixelData;
5343 begin
5344   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5345   with PixelData do begin
5346     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5347     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5348     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5349     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5350   end;
5351   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5352 end;
5353
5354 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5355 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
5356 begin
5357   //check MIN filter
5358   case aMin of
5359     GL_NEAREST:
5360       fFilterMin := GL_NEAREST;
5361     GL_LINEAR:
5362       fFilterMin := GL_LINEAR;
5363     GL_NEAREST_MIPMAP_NEAREST:
5364       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5365     GL_LINEAR_MIPMAP_NEAREST:
5366       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5367     GL_NEAREST_MIPMAP_LINEAR:
5368       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5369     GL_LINEAR_MIPMAP_LINEAR:
5370       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5371     else
5372       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
5373   end;
5374
5375   //check MAG filter
5376   case aMag of
5377     GL_NEAREST:
5378       fFilterMag := GL_NEAREST;
5379     GL_LINEAR:
5380       fFilterMag := GL_LINEAR;
5381     else
5382       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
5383   end;
5384
5385   //apply filter
5386   if (ID > 0) then begin
5387     Bind(false);
5388     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5389
5390     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5391       case fFilterMin of
5392         GL_NEAREST, GL_LINEAR:
5393           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5394         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5395           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5396         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5397           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5398       end;
5399     end else
5400       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5401   end;
5402 end;
5403
5404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5405 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
5406
5407   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5408   begin
5409     case aValue of
5410       GL_CLAMP:
5411         aTarget := GL_CLAMP;
5412
5413       GL_REPEAT:
5414         aTarget := GL_REPEAT;
5415
5416       GL_CLAMP_TO_EDGE: begin
5417         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5418           aTarget := GL_CLAMP_TO_EDGE
5419         else
5420           aTarget := GL_CLAMP;
5421       end;
5422
5423       GL_CLAMP_TO_BORDER: begin
5424         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5425           aTarget := GL_CLAMP_TO_BORDER
5426         else
5427           aTarget := GL_CLAMP;
5428       end;
5429
5430       GL_MIRRORED_REPEAT: begin
5431         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5432           aTarget := GL_MIRRORED_REPEAT
5433         else
5434           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5435       end;
5436     else
5437       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
5438     end;
5439   end;
5440
5441 begin
5442   CheckAndSetWrap(S, fWrapS);
5443   CheckAndSetWrap(T, fWrapT);
5444   CheckAndSetWrap(R, fWrapR);
5445
5446   if (ID > 0) then begin
5447     Bind(false);
5448     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5449     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5450     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5451   end;
5452 end;
5453
5454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5455 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5456 begin
5457   if aEnableTextureUnit then
5458     glEnable(Target);
5459   if (ID > 0) then
5460     glBindTexture(Target, ID);
5461 end;
5462
5463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5464 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5465 begin
5466   if aDisableTextureUnit then
5467     glDisable(Target);
5468   glBindTexture(Target, 0);
5469 end;
5470
5471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5472 constructor TglBitmap.Create;
5473 begin
5474 {$IFDEF GLB_NATIVE_OGL}
5475   glbReadOpenGLExtensions;
5476 {$ENDIF}
5477   if (ClassType = TglBitmap) then
5478     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5479   inherited Create;
5480 end;
5481
5482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5483 constructor TglBitmap.Create(const aFileName: String);
5484 begin
5485   Create;
5486   LoadFromFile(FileName);
5487 end;
5488
5489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5490 constructor TglBitmap.Create(const aStream: TStream);
5491 begin
5492   Create;
5493   LoadFromStream(aStream);
5494 end;
5495
5496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5497 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5498 var
5499   Image: PByte;
5500   ImageSize: Integer;
5501 begin
5502   Create;
5503   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5504   GetMem(Image, ImageSize);
5505   try
5506     FillChar(Image^, ImageSize, #$FF);
5507     SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
5508   except
5509     FreeMem(Image);
5510     raise;
5511   end;
5512 end;
5513
5514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5515 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5516   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5517 begin
5518   Create;
5519   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5520 end;
5521
5522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5523 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5524 begin
5525   Create;
5526   LoadFromResource(aInstance, aResource, aResType);
5527 end;
5528
5529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5530 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5531 begin
5532   Create;
5533   LoadFromResourceID(aInstance, aResourceID, aResType);
5534 end;
5535
5536 {$IFDEF GLB_SUPPORT_PNG_READ}
5537 {$IF DEFINED(GLB_SDL_IMAGE)}
5538 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5539 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5540 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5541 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5542 var
5543   Surface: PSDL_Surface;
5544   RWops: PSDL_RWops;
5545 begin
5546   result := false;
5547   RWops := glBitmapCreateRWops(aStream);
5548   try
5549     if IMG_isPNG(RWops) > 0 then begin
5550       Surface := IMG_LoadPNG_RW(RWops);
5551       try
5552         AssignFromSurface(Surface);
5553         result := true;
5554       finally
5555         SDL_FreeSurface(Surface);
5556       end;
5557     end;
5558   finally
5559     SDL_FreeRW(RWops);
5560   end;
5561 end;
5562
5563 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5564 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5565 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5566 begin
5567   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5568 end;
5569
5570 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5571 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5572 var
5573   StreamPos: Int64;
5574   signature: array [0..7] of byte;
5575   png: png_structp;
5576   png_info: png_infop;
5577
5578   TempHeight, TempWidth: Integer;
5579   Format: TglBitmapFormat;
5580
5581   png_data: pByte;
5582   png_rows: array of pByte;
5583   Row, LineSize: Integer;
5584 begin
5585   result := false;
5586
5587   if not init_libPNG then
5588     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5589
5590   try
5591     // signature
5592     StreamPos := aStream.Position;
5593     aStream.Read(signature{%H-}, 8);
5594     aStream.Position := StreamPos;
5595
5596     if png_check_sig(@signature, 8) <> 0 then begin
5597       // png read struct
5598       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5599       if png = nil then
5600         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5601
5602       // png info
5603       png_info := png_create_info_struct(png);
5604       if png_info = nil then begin
5605         png_destroy_read_struct(@png, nil, nil);
5606         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5607       end;
5608
5609       // set read callback
5610       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5611
5612       // read informations
5613       png_read_info(png, png_info);
5614
5615       // size
5616       TempHeight := png_get_image_height(png, png_info);
5617       TempWidth := png_get_image_width(png, png_info);
5618
5619       // format
5620       case png_get_color_type(png, png_info) of
5621         PNG_COLOR_TYPE_GRAY:
5622           Format := tfLuminance8;
5623         PNG_COLOR_TYPE_GRAY_ALPHA:
5624           Format := tfLuminance8Alpha8;
5625         PNG_COLOR_TYPE_RGB:
5626           Format := tfRGB8;
5627         PNG_COLOR_TYPE_RGB_ALPHA:
5628           Format := tfRGBA8;
5629         else
5630           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5631       end;
5632
5633       // cut upper 8 bit from 16 bit formats
5634       if png_get_bit_depth(png, png_info) > 8 then
5635         png_set_strip_16(png);
5636
5637       // expand bitdepth smaller than 8
5638       if png_get_bit_depth(png, png_info) < 8 then
5639         png_set_expand(png);
5640
5641       // allocating mem for scanlines
5642       LineSize := png_get_rowbytes(png, png_info);
5643       GetMem(png_data, TempHeight * LineSize);
5644       try
5645         SetLength(png_rows, TempHeight);
5646         for Row := Low(png_rows) to High(png_rows) do begin
5647           png_rows[Row] := png_data;
5648           Inc(png_rows[Row], Row * LineSize);
5649         end;
5650
5651         // read complete image into scanlines
5652         png_read_image(png, @png_rows[0]);
5653
5654         // read end
5655         png_read_end(png, png_info);
5656
5657         // destroy read struct
5658         png_destroy_read_struct(@png, @png_info, nil);
5659
5660         SetLength(png_rows, 0);
5661
5662         // set new data
5663         SetDataPointer(png_data, Format, TempWidth, TempHeight);
5664
5665         result := true;
5666       except
5667         FreeMem(png_data);
5668         raise;
5669       end;
5670     end;
5671   finally
5672     quit_libPNG;
5673   end;
5674 end;
5675
5676 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5678 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5679 var
5680   StreamPos: Int64;
5681   Png: TPNGObject;
5682   Header: String[8];
5683   Row, Col, PixSize, LineSize: Integer;
5684   NewImage, pSource, pDest, pAlpha: pByte;
5685   PngFormat: TglBitmapFormat;
5686   FormatDesc: TFormatDescriptor;
5687
5688 const
5689   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5690
5691 begin
5692   result := false;
5693
5694   StreamPos := aStream.Position;
5695   aStream.Read(Header[0], SizeOf(Header));
5696   aStream.Position := StreamPos;
5697
5698   {Test if the header matches}
5699   if Header = PngHeader then begin
5700     Png := TPNGObject.Create;
5701     try
5702       Png.LoadFromStream(aStream);
5703
5704       case Png.Header.ColorType of
5705         COLOR_GRAYSCALE:
5706           PngFormat := tfLuminance8;
5707         COLOR_GRAYSCALEALPHA:
5708           PngFormat := tfLuminance8Alpha8;
5709         COLOR_RGB:
5710           PngFormat := tfBGR8;
5711         COLOR_RGBALPHA:
5712           PngFormat := tfBGRA8;
5713         else
5714           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5715       end;
5716
5717       FormatDesc := TFormatDescriptor.Get(PngFormat);
5718       PixSize    := Round(FormatDesc.PixelSize);
5719       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5720
5721       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5722       try
5723         pDest := NewImage;
5724
5725         case Png.Header.ColorType of
5726           COLOR_RGB, COLOR_GRAYSCALE:
5727             begin
5728               for Row := 0 to Png.Height -1 do begin
5729                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5730                 Inc(pDest, LineSize);
5731               end;
5732             end;
5733           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5734             begin
5735               PixSize := PixSize -1;
5736
5737               for Row := 0 to Png.Height -1 do begin
5738                 pSource := Png.Scanline[Row];
5739                 pAlpha := pByte(Png.AlphaScanline[Row]);
5740
5741                 for Col := 0 to Png.Width -1 do begin
5742                   Move (pSource^, pDest^, PixSize);
5743                   Inc(pSource, PixSize);
5744                   Inc(pDest, PixSize);
5745
5746                   pDest^ := pAlpha^;
5747                   inc(pAlpha);
5748                   Inc(pDest);
5749                 end;
5750               end;
5751             end;
5752           else
5753             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5754         end;
5755
5756         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
5757
5758         result := true;
5759       except
5760         FreeMem(NewImage);
5761         raise;
5762       end;
5763     finally
5764       Png.Free;
5765     end;
5766   end;
5767 end;
5768 {$ENDIF}
5769 {$ENDIF}
5770
5771 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5772 {$IFDEF GLB_LIB_PNG}
5773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5774 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5775 begin
5776   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5777 end;
5778 {$ENDIF}
5779
5780 {$IF DEFINED(GLB_LIB_PNG)}
5781 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5782 procedure TglBitmap.SavePNG(const aStream: TStream);
5783 var
5784   png: png_structp;
5785   png_info: png_infop;
5786   png_rows: array of pByte;
5787   LineSize: Integer;
5788   ColorType: Integer;
5789   Row: Integer;
5790   FormatDesc: TFormatDescriptor;
5791 begin
5792   if not (ftPNG in FormatGetSupportedFiles(Format)) then
5793     raise EglBitmapUnsupportedFormat.Create(Format);
5794
5795   if not init_libPNG then
5796     raise Exception.Create('unable to initialize libPNG.');
5797
5798   try
5799     case Format of
5800       tfAlpha8, tfLuminance8:
5801         ColorType := PNG_COLOR_TYPE_GRAY;
5802       tfLuminance8Alpha8:
5803         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5804       tfBGR8, tfRGB8:
5805         ColorType := PNG_COLOR_TYPE_RGB;
5806       tfBGRA8, tfRGBA8:
5807         ColorType := PNG_COLOR_TYPE_RGBA;
5808       else
5809         raise EglBitmapUnsupportedFormat.Create(Format);
5810     end;
5811
5812     FormatDesc := TFormatDescriptor.Get(Format);
5813     LineSize := FormatDesc.GetSize(Width, 1);
5814
5815     // creating array for scanline
5816     SetLength(png_rows, Height);
5817     try
5818       for Row := 0 to Height - 1 do begin
5819         png_rows[Row] := Data;
5820         Inc(png_rows[Row], Row * LineSize)
5821       end;
5822
5823       // write struct
5824       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5825       if png = nil then
5826         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5827
5828       // create png info
5829       png_info := png_create_info_struct(png);
5830       if png_info = nil then begin
5831         png_destroy_write_struct(@png, nil);
5832         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5833       end;
5834
5835       // set read callback
5836       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
5837
5838       // set compression
5839       png_set_compression_level(png, 6);
5840
5841       if Format in [tfBGR8, tfBGRA8] then
5842         png_set_bgr(png);
5843
5844       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5845       png_write_info(png, png_info);
5846       png_write_image(png, @png_rows[0]);
5847       png_write_end(png, png_info);
5848       png_destroy_write_struct(@png, @png_info);
5849     finally
5850       SetLength(png_rows, 0);
5851     end;
5852   finally
5853     quit_libPNG;
5854   end;
5855 end;
5856
5857 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5858 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5859 procedure TglBitmap.SavePNG(const aStream: TStream);
5860 var
5861   Png: TPNGObject;
5862
5863   pSource, pDest: pByte;
5864   X, Y, PixSize: Integer;
5865   ColorType: Cardinal;
5866   Alpha: Boolean;
5867
5868   pTemp: pByte;
5869   Temp: Byte;
5870 begin
5871   if not (ftPNG in FormatGetSupportedFiles (Format)) then
5872     raise EglBitmapUnsupportedFormat.Create(Format);
5873
5874   case Format of
5875     tfAlpha8, tfLuminance8: begin
5876       ColorType := COLOR_GRAYSCALE;
5877       PixSize   := 1;
5878       Alpha     := false;
5879     end;
5880     tfLuminance8Alpha8: begin
5881       ColorType := COLOR_GRAYSCALEALPHA;
5882       PixSize   := 1;
5883       Alpha     := true;
5884     end;
5885     tfBGR8, tfRGB8: begin
5886       ColorType := COLOR_RGB;
5887       PixSize   := 3;
5888       Alpha     := false;
5889     end;
5890     tfBGRA8, tfRGBA8: begin
5891       ColorType := COLOR_RGBALPHA;
5892       PixSize   := 3;
5893       Alpha     := true
5894     end;
5895   else
5896     raise EglBitmapUnsupportedFormat.Create(Format);
5897   end;
5898
5899   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5900   try
5901     // Copy ImageData
5902     pSource := Data;
5903     for Y := 0 to Height -1 do begin
5904       pDest := png.ScanLine[Y];
5905       for X := 0 to Width -1 do begin
5906         Move(pSource^, pDest^, PixSize);
5907         Inc(pDest, PixSize);
5908         Inc(pSource, PixSize);
5909         if Alpha then begin
5910           png.AlphaScanline[Y]^[X] := pSource^;
5911           Inc(pSource);
5912         end;
5913       end;
5914
5915       // convert RGB line to BGR
5916       if Format in [tfRGB8, tfRGBA8] then begin
5917         pTemp := png.ScanLine[Y];
5918         for X := 0 to Width -1 do begin
5919           Temp := pByteArray(pTemp)^[0];
5920           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5921           pByteArray(pTemp)^[2] := Temp;
5922           Inc(pTemp, 3);
5923         end;
5924       end;
5925     end;
5926
5927     // Save to Stream
5928     Png.CompressionLevel := 6;
5929     Png.SaveToStream(aStream);
5930   finally
5931     FreeAndNil(Png);
5932   end;
5933 end;
5934 {$ENDIF}
5935 {$ENDIF}
5936
5937 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5938 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5939 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5940 {$IFDEF GLB_LIB_JPEG}
5941 type
5942   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
5943   glBitmap_libJPEG_source_mgr = record
5944     pub: jpeg_source_mgr;
5945
5946     SrcStream: TStream;
5947     SrcBuffer: array [1..4096] of byte;
5948   end;
5949
5950   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
5951   glBitmap_libJPEG_dest_mgr = record
5952     pub: jpeg_destination_mgr;
5953
5954     DestStream: TStream;
5955     DestBuffer: array [1..4096] of byte;
5956   end;
5957
5958 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
5959 begin
5960   //DUMMY
5961 end;
5962
5963
5964 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
5965 begin
5966   //DUMMY
5967 end;
5968
5969
5970 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
5971 begin
5972   //DUMMY
5973 end;
5974
5975 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
5976 begin
5977   //DUMMY
5978 end;
5979
5980
5981 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
5982 begin
5983   //DUMMY
5984 end;
5985
5986
5987 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5988 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
5989 var
5990   src: glBitmap_libJPEG_source_mgr_ptr;
5991   bytes: integer;
5992 begin
5993   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5994
5995   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
5996         if (bytes <= 0) then begin
5997                 src^.SrcBuffer[1] := $FF;
5998                 src^.SrcBuffer[2] := JPEG_EOI;
5999                 bytes := 2;
6000         end;
6001
6002         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6003         src^.pub.bytes_in_buffer := bytes;
6004
6005   result := true;
6006 end;
6007
6008 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6009 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6010 var
6011   src: glBitmap_libJPEG_source_mgr_ptr;
6012 begin
6013   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6014
6015   if num_bytes > 0 then begin
6016     // wanted byte isn't in buffer so set stream position and read buffer
6017     if num_bytes > src^.pub.bytes_in_buffer then begin
6018       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6019       src^.pub.fill_input_buffer(cinfo);
6020     end else begin
6021       // wanted byte is in buffer so only skip
6022                 inc(src^.pub.next_input_byte, num_bytes);
6023                 dec(src^.pub.bytes_in_buffer, num_bytes);
6024     end;
6025   end;
6026 end;
6027
6028 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6029 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6030 var
6031   dest: glBitmap_libJPEG_dest_mgr_ptr;
6032 begin
6033   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6034
6035   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6036     // write complete buffer
6037     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6038
6039     // reset buffer
6040     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6041     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6042   end;
6043
6044   result := true;
6045 end;
6046
6047 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6048 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6049 var
6050   Idx: Integer;
6051   dest: glBitmap_libJPEG_dest_mgr_ptr;
6052 begin
6053   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6054
6055   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6056     // check for endblock
6057     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6058       // write endblock
6059       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6060
6061       // leave
6062       break;
6063     end else
6064       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6065   end;
6066 end;
6067 {$ENDIF}
6068
6069 {$IFDEF GLB_SUPPORT_JPEG_READ}
6070 {$IF DEFINED(GLB_SDL_IMAGE)}
6071 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6072 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6073 var
6074   Surface: PSDL_Surface;
6075   RWops: PSDL_RWops;
6076 begin
6077   result := false;
6078
6079   RWops := glBitmapCreateRWops(aStream);
6080   try
6081     if IMG_isJPG(RWops) > 0 then begin
6082       Surface := IMG_LoadJPG_RW(RWops);
6083       try
6084         AssignFromSurface(Surface);
6085         result := true;
6086       finally
6087         SDL_FreeSurface(Surface);
6088       end;
6089     end;
6090   finally
6091     SDL_FreeRW(RWops);
6092   end;
6093 end;
6094
6095 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6097 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6098 var
6099   StreamPos: Int64;
6100   Temp: array[0..1]of Byte;
6101
6102   jpeg: jpeg_decompress_struct;
6103   jpeg_err: jpeg_error_mgr;
6104
6105   IntFormat: TglBitmapFormat;
6106   pImage: pByte;
6107   TempHeight, TempWidth: Integer;
6108
6109   pTemp: pByte;
6110   Row: Integer;
6111
6112   FormatDesc: TFormatDescriptor;
6113 begin
6114   result := false;
6115
6116   if not init_libJPEG then
6117     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6118
6119   try
6120     // reading first two bytes to test file and set cursor back to begin
6121     StreamPos := aStream.Position;
6122     aStream.Read({%H-}Temp[0], 2);
6123     aStream.Position := StreamPos;
6124
6125     // if Bitmap then read file.
6126     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6127       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6128       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6129
6130       // error managment
6131       jpeg.err := jpeg_std_error(@jpeg_err);
6132       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6133       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6134
6135       // decompression struct
6136       jpeg_create_decompress(@jpeg);
6137
6138       // allocation space for streaming methods
6139       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6140
6141       // seeting up custom functions
6142       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6143         pub.init_source       := glBitmap_libJPEG_init_source;
6144         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6145         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6146         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6147         pub.term_source       := glBitmap_libJPEG_term_source;
6148
6149         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6150         pub.next_input_byte := nil;   // until buffer loaded
6151
6152         SrcStream := aStream;
6153       end;
6154
6155       // set global decoding state
6156       jpeg.global_state := DSTATE_START;
6157
6158       // read header of jpeg
6159       jpeg_read_header(@jpeg, false);
6160
6161       // setting output parameter
6162       case jpeg.jpeg_color_space of
6163         JCS_GRAYSCALE:
6164           begin
6165             jpeg.out_color_space := JCS_GRAYSCALE;
6166             IntFormat := tfLuminance8;
6167           end;
6168         else
6169           jpeg.out_color_space := JCS_RGB;
6170           IntFormat := tfRGB8;
6171       end;
6172
6173       // reading image
6174       jpeg_start_decompress(@jpeg);
6175
6176       TempHeight := jpeg.output_height;
6177       TempWidth := jpeg.output_width;
6178
6179       FormatDesc := TFormatDescriptor.Get(IntFormat);
6180
6181       // creating new image
6182       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6183       try
6184         pTemp := pImage;
6185
6186         for Row := 0 to TempHeight -1 do begin
6187           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6188           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6189         end;
6190
6191         // finish decompression
6192         jpeg_finish_decompress(@jpeg);
6193
6194         // destroy decompression
6195         jpeg_destroy_decompress(@jpeg);
6196
6197         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
6198
6199         result := true;
6200       except
6201         FreeMem(pImage);
6202         raise;
6203       end;
6204     end;
6205   finally
6206     quit_libJPEG;
6207   end;
6208 end;
6209
6210 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6212 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6213 var
6214   bmp: TBitmap;
6215   jpg: TJPEGImage;
6216   StreamPos: Int64;
6217   Temp: array[0..1]of Byte;
6218 begin
6219   result := false;
6220
6221   // reading first two bytes to test file and set cursor back to begin
6222   StreamPos := Stream.Position;
6223   Stream.Read(Temp[0], 2);
6224   Stream.Position := StreamPos;
6225
6226   // if Bitmap then read file.
6227   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6228     bmp := TBitmap.Create;
6229     try
6230       jpg := TJPEGImage.Create;
6231       try
6232         jpg.LoadFromStream(Stream);
6233         bmp.Assign(jpg);
6234         result := AssignFromBitmap(bmp);
6235       finally
6236         jpg.Free;
6237       end;
6238     finally
6239       bmp.Free;
6240     end;
6241   end;
6242 end;
6243 {$ENDIF}
6244 {$ENDIF}
6245
6246 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6247 {$IF DEFINED(GLB_LIB_JPEG)}
6248 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6249 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6250 var
6251   jpeg: jpeg_compress_struct;
6252   jpeg_err: jpeg_error_mgr;
6253   Row: Integer;
6254   pTemp, pTemp2: pByte;
6255
6256   procedure CopyRow(pDest, pSource: pByte);
6257   var
6258     X: Integer;
6259   begin
6260     for X := 0 to Width - 1 do begin
6261       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6262       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6263       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6264       Inc(pDest, 3);
6265       Inc(pSource, 3);
6266     end;
6267   end;
6268
6269 begin
6270   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6271     raise EglBitmapUnsupportedFormat.Create(Format);
6272
6273   if not init_libJPEG then
6274     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6275
6276   try
6277     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6278     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6279
6280     // error managment
6281     jpeg.err := jpeg_std_error(@jpeg_err);
6282     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6283     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6284
6285     // compression struct
6286     jpeg_create_compress(@jpeg);
6287
6288     // allocation space for streaming methods
6289     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6290
6291     // seeting up custom functions
6292     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6293       pub.init_destination    := glBitmap_libJPEG_init_destination;
6294       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6295       pub.term_destination    := glBitmap_libJPEG_term_destination;
6296
6297       pub.next_output_byte  := @DestBuffer[1];
6298       pub.free_in_buffer    := Length(DestBuffer);
6299
6300       DestStream := aStream;
6301     end;
6302
6303     // very important state
6304     jpeg.global_state := CSTATE_START;
6305     jpeg.image_width  := Width;
6306     jpeg.image_height := Height;
6307     case Format of
6308       tfAlpha8, tfLuminance8: begin
6309         jpeg.input_components := 1;
6310         jpeg.in_color_space   := JCS_GRAYSCALE;
6311       end;
6312       tfRGB8, tfBGR8: begin
6313         jpeg.input_components := 3;
6314         jpeg.in_color_space   := JCS_RGB;
6315       end;
6316     end;
6317
6318     jpeg_set_defaults(@jpeg);
6319     jpeg_set_quality(@jpeg, 95, true);
6320     jpeg_start_compress(@jpeg, true);
6321     pTemp := Data;
6322
6323     if Format = tfBGR8 then
6324       GetMem(pTemp2, fRowSize)
6325     else
6326       pTemp2 := pTemp;
6327
6328     try
6329       for Row := 0 to jpeg.image_height -1 do begin
6330         // prepare row
6331         if Format = tfBGR8 then
6332           CopyRow(pTemp2, pTemp)
6333         else
6334           pTemp2 := pTemp;
6335
6336         // write row
6337         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6338         inc(pTemp, fRowSize);
6339       end;
6340     finally
6341       // free memory
6342       if Format = tfBGR8 then
6343         FreeMem(pTemp2);
6344     end;
6345     jpeg_finish_compress(@jpeg);
6346     jpeg_destroy_compress(@jpeg);
6347   finally
6348     quit_libJPEG;
6349   end;
6350 end;
6351
6352 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6354 procedure TglBitmap.SaveJPEG(Stream: TStream);
6355 var
6356   Bmp: TBitmap;
6357   Jpg: TJPEGImage;
6358 begin
6359   if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
6360     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
6361
6362   Bmp := TBitmap.Create;
6363   try
6364     Jpg := TJPEGImage.Create;
6365     try
6366       AssignToBitmap(Bmp);
6367       if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
6368         Jpg.Grayscale := true;
6369         Jpg.PixelFormat := jf8Bit;
6370       end;
6371       Jpg.Assign(Bmp);
6372       Jpg.SaveToStream(Stream);
6373     finally
6374       FreeAndNil(Jpg);
6375     end;
6376   finally
6377     FreeAndNil(Bmp);
6378   end;
6379 end;
6380 {$ENDIF}
6381 {$ENDIF}
6382
6383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6384 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6386 const
6387   BMP_MAGIC          = $4D42;
6388
6389   BMP_COMP_RGB       = 0;
6390   BMP_COMP_RLE8      = 1;
6391   BMP_COMP_RLE4      = 2;
6392   BMP_COMP_BITFIELDS = 3;
6393
6394 type
6395   TBMPHeader = packed record
6396     bfType: Word;
6397     bfSize: Cardinal;
6398     bfReserved1: Word;
6399     bfReserved2: Word;
6400     bfOffBits: Cardinal;
6401   end;
6402
6403   TBMPInfo = packed record
6404     biSize: Cardinal;
6405     biWidth: Longint;
6406     biHeight: Longint;
6407     biPlanes: Word;
6408     biBitCount: Word;
6409     biCompression: Cardinal;
6410     biSizeImage: Cardinal;
6411     biXPelsPerMeter: Longint;
6412     biYPelsPerMeter: Longint;
6413     biClrUsed: Cardinal;
6414     biClrImportant: Cardinal;
6415   end;
6416
6417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6418 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6419
6420   //////////////////////////////////////////////////////////////////////////////////////////////////
6421   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6422   begin
6423     result := tfEmpty;
6424     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6425     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6426
6427     //Read Compression
6428     case aInfo.biCompression of
6429       BMP_COMP_RLE4,
6430       BMP_COMP_RLE8: begin
6431         raise EglBitmapException.Create('RLE compression is not supported');
6432       end;
6433       BMP_COMP_BITFIELDS: begin
6434         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6435           aStream.Read(aMask.r, SizeOf(aMask.r));
6436           aStream.Read(aMask.g, SizeOf(aMask.g));
6437           aStream.Read(aMask.b, SizeOf(aMask.b));
6438           aStream.Read(aMask.a, SizeOf(aMask.a));
6439         end else
6440           raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
6441       end;
6442     end;
6443
6444     //get suitable format
6445     case aInfo.biBitCount of
6446        8: result := tfLuminance8;
6447       16: result := tfBGR5;
6448       24: result := tfBGR8;
6449       32: result := tfBGRA8;
6450     end;
6451   end;
6452
6453   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6454   var
6455     i, c: Integer;
6456     ColorTable: TbmpColorTable;
6457   begin
6458     result := nil;
6459     if (aInfo.biBitCount >= 16) then
6460       exit;
6461     aFormat := tfLuminance8;
6462     c := aInfo.biClrUsed;
6463     if (c = 0) then
6464       c := 1 shl aInfo.biBitCount;
6465     SetLength(ColorTable, c);
6466     for i := 0 to c-1 do begin
6467       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6468       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6469         aFormat := tfRGB8;
6470     end;
6471
6472     result := TbmpColorTableFormat.Create;
6473     result.PixelSize  := aInfo.biBitCount / 8;
6474     result.ColorTable := ColorTable;
6475     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6476   end;
6477
6478   //////////////////////////////////////////////////////////////////////////////////////////////////
6479   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6480     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6481   var
6482     TmpFormat: TglBitmapFormat;
6483     FormatDesc: TFormatDescriptor;
6484   begin
6485     result := nil;
6486     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6487       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6488         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6489         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6490           aFormat := FormatDesc.Format;
6491           exit;
6492         end;
6493       end;
6494
6495       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6496         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6497       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6498         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6499
6500       result := TbmpBitfieldFormat.Create;
6501       result.PixelSize := aInfo.biBitCount / 8;
6502       result.RedMask   := aMask.r;
6503       result.GreenMask := aMask.g;
6504       result.BlueMask  := aMask.b;
6505       result.AlphaMask := aMask.a;
6506     end;
6507   end;
6508
6509 var
6510   //simple types
6511   StartPos: Int64;
6512   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6513   PaddingBuff: Cardinal;
6514   LineBuf, ImageData, TmpData: PByte;
6515   SourceMD, DestMD: Pointer;
6516   BmpFormat: TglBitmapFormat;
6517
6518   //records
6519   Mask: TglBitmapColorRec;
6520   Header: TBMPHeader;
6521   Info: TBMPInfo;
6522
6523   //classes
6524   SpecialFormat: TFormatDescriptor;
6525   FormatDesc: TFormatDescriptor;
6526
6527   //////////////////////////////////////////////////////////////////////////////////////////////////
6528   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6529   var
6530     i: Integer;
6531     Pixel: TglBitmapPixelData;
6532   begin
6533     aStream.Read(aLineBuf^, rbLineSize);
6534     SpecialFormat.PreparePixel(Pixel);
6535     for i := 0 to Info.biWidth-1 do begin
6536       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6537       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6538       FormatDesc.Map(Pixel, aData, DestMD);
6539     end;
6540   end;
6541
6542 begin
6543   result        := false;
6544   BmpFormat     := tfEmpty;
6545   SpecialFormat := nil;
6546   LineBuf       := nil;
6547   SourceMD      := nil;
6548   DestMD        := nil;
6549
6550   // Header
6551   StartPos := aStream.Position;
6552   aStream.Read(Header{%H-}, SizeOf(Header));
6553
6554   if Header.bfType = BMP_MAGIC then begin
6555     try try
6556       BmpFormat        := ReadInfo(Info, Mask);
6557       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6558       if not Assigned(SpecialFormat) then
6559         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6560       aStream.Position := StartPos + Header.bfOffBits;
6561
6562       if (BmpFormat <> tfEmpty) then begin
6563         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6564         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6565         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6566         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6567
6568         //get Memory
6569         DestMD    := FormatDesc.CreateMappingData;
6570         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6571         GetMem(ImageData, ImageSize);
6572         if Assigned(SpecialFormat) then begin
6573           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6574           SourceMD := SpecialFormat.CreateMappingData;
6575         end;
6576
6577         //read Data
6578         try try
6579           FillChar(ImageData^, ImageSize, $FF);
6580           TmpData := ImageData;
6581           if (Info.biHeight > 0) then
6582             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6583           for i := 0 to Abs(Info.biHeight)-1 do begin
6584             if Assigned(SpecialFormat) then
6585               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6586             else
6587               aStream.Read(TmpData^, wbLineSize);   //else only read data
6588             if (Info.biHeight > 0) then
6589               dec(TmpData, wbLineSize)
6590             else
6591               inc(TmpData, wbLineSize);
6592             aStream.Read(PaddingBuff{%H-}, Padding);
6593           end;
6594           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
6595           result := true;
6596         finally
6597           if Assigned(LineBuf) then
6598             FreeMem(LineBuf);
6599           if Assigned(SourceMD) then
6600             SpecialFormat.FreeMappingData(SourceMD);
6601           FormatDesc.FreeMappingData(DestMD);
6602         end;
6603         except
6604           FreeMem(ImageData);
6605           raise;
6606         end;
6607       end else
6608         raise EglBitmapException.Create('LoadBMP - No suitable format found');
6609     except
6610       aStream.Position := StartPos;
6611       raise;
6612     end;
6613     finally
6614       FreeAndNil(SpecialFormat);
6615     end;
6616   end
6617     else aStream.Position := StartPos;
6618 end;
6619
6620 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6621 procedure TglBitmap.SaveBMP(const aStream: TStream);
6622 var
6623   Header: TBMPHeader;
6624   Info: TBMPInfo;
6625   Converter: TbmpColorTableFormat;
6626   FormatDesc: TFormatDescriptor;
6627   SourceFD, DestFD: Pointer;
6628   pData, srcData, dstData, ConvertBuffer: pByte;
6629
6630   Pixel: TglBitmapPixelData;
6631   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6632   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6633
6634   PaddingBuff: Cardinal;
6635
6636   function GetLineWidth : Integer;
6637   begin
6638     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6639   end;
6640
6641 begin
6642   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6643     raise EglBitmapUnsupportedFormat.Create(Format);
6644
6645   Converter  := nil;
6646   FormatDesc := TFormatDescriptor.Get(Format);
6647   ImageSize  := FormatDesc.GetSize(Dimension);
6648
6649   FillChar(Header{%H-}, SizeOf(Header), 0);
6650   Header.bfType      := BMP_MAGIC;
6651   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6652   Header.bfReserved1 := 0;
6653   Header.bfReserved2 := 0;
6654   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6655
6656   FillChar(Info{%H-}, SizeOf(Info), 0);
6657   Info.biSize        := SizeOf(Info);
6658   Info.biWidth       := Width;
6659   Info.biHeight      := Height;
6660   Info.biPlanes      := 1;
6661   Info.biCompression := BMP_COMP_RGB;
6662   Info.biSizeImage   := ImageSize;
6663
6664   try
6665     case Format of
6666       tfLuminance4: begin
6667         Info.biBitCount  := 4;
6668         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6669         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6670         Converter           := TbmpColorTableFormat.Create;
6671         Converter.PixelSize := 0.5;
6672         Converter.Format    := Format;
6673         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);
6674         Converter.CreateColorTable;
6675       end;
6676
6677       tfR3G3B2, tfLuminance8: begin
6678         Info.biBitCount  :=  8;
6679         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6680         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6681         Converter           := TbmpColorTableFormat.Create;
6682         Converter.PixelSize := 1;
6683         Converter.Format    := Format;
6684         if (Format = tfR3G3B2) then begin
6685           Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6686           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6687         end else
6688           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6689         Converter.CreateColorTable;
6690       end;
6691
6692       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6693       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6694         Info.biBitCount    := 16;
6695         Info.biCompression := BMP_COMP_BITFIELDS;
6696       end;
6697
6698       tfBGR8, tfRGB8: begin
6699         Info.biBitCount := 24;
6700       end;
6701
6702       tfRGB10, tfRGB10A2, tfRGBA8,
6703       tfBGR10, tfBGR10A2, tfBGRA8: begin
6704         Info.biBitCount    := 32;
6705         Info.biCompression := BMP_COMP_BITFIELDS;
6706       end;
6707     else
6708       raise EglBitmapUnsupportedFormat.Create(Format);
6709     end;
6710     Info.biXPelsPerMeter := 2835;
6711     Info.biYPelsPerMeter := 2835;
6712
6713     // prepare bitmasks
6714     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6715       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
6716       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6717
6718       RedMask    := FormatDesc.RedMask;
6719       GreenMask  := FormatDesc.GreenMask;
6720       BlueMask   := FormatDesc.BlueMask;
6721       AlphaMask  := FormatDesc.AlphaMask;
6722     end;
6723
6724     // headers
6725     aStream.Write(Header, SizeOf(Header));
6726     aStream.Write(Info, SizeOf(Info));
6727
6728     // colortable
6729     if Assigned(Converter) then
6730       aStream.Write(Converter.ColorTable[0].b,
6731         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6732
6733     // bitmasks
6734     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6735       aStream.Write(RedMask,   SizeOf(Cardinal));
6736       aStream.Write(GreenMask, SizeOf(Cardinal));
6737       aStream.Write(BlueMask,  SizeOf(Cardinal));
6738       aStream.Write(AlphaMask, SizeOf(Cardinal));
6739     end;
6740
6741     // image data
6742     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
6743     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
6744     Padding     := GetLineWidth - wbLineSize;
6745     PaddingBuff := 0;
6746
6747     pData := Data;
6748     inc(pData, (Height-1) * rbLineSize);
6749
6750     // prepare row buffer. But only for RGB because RGBA supports color masks
6751     // so it's possible to change color within the image.
6752     if Assigned(Converter) then begin
6753       FormatDesc.PreparePixel(Pixel);
6754       GetMem(ConvertBuffer, wbLineSize);
6755       SourceFD := FormatDesc.CreateMappingData;
6756       DestFD   := Converter.CreateMappingData;
6757     end else
6758       ConvertBuffer := nil;
6759
6760     try
6761       for LineIdx := 0 to Height - 1 do begin
6762         // preparing row
6763         if Assigned(Converter) then begin
6764           srcData := pData;
6765           dstData := ConvertBuffer;
6766           for PixelIdx := 0 to Info.biWidth-1 do begin
6767             FormatDesc.Unmap(srcData, Pixel, SourceFD);
6768             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
6769             Converter.Map(Pixel, dstData, DestFD);
6770           end;
6771           aStream.Write(ConvertBuffer^, wbLineSize);
6772         end else begin
6773           aStream.Write(pData^, rbLineSize);
6774         end;
6775         dec(pData, rbLineSize);
6776         if (Padding > 0) then
6777           aStream.Write(PaddingBuff, Padding);
6778       end;
6779     finally
6780       // destroy row buffer
6781       if Assigned(ConvertBuffer) then begin
6782         FormatDesc.FreeMappingData(SourceFD);
6783         Converter.FreeMappingData(DestFD);
6784         FreeMem(ConvertBuffer);
6785       end;
6786     end;
6787   finally
6788     if Assigned(Converter) then
6789       Converter.Free;
6790   end;
6791 end;
6792
6793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6794 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6795 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6796 type
6797   TTGAHeader = packed record
6798     ImageID: Byte;
6799     ColorMapType: Byte;
6800     ImageType: Byte;
6801     //ColorMapSpec: Array[0..4] of Byte;
6802     ColorMapStart: Word;
6803     ColorMapLength: Word;
6804     ColorMapEntrySize: Byte;
6805     OrigX: Word;
6806     OrigY: Word;
6807     Width: Word;
6808     Height: Word;
6809     Bpp: Byte;
6810     ImageDesc: Byte;
6811   end;
6812
6813 const
6814   TGA_UNCOMPRESSED_RGB  =  2;
6815   TGA_UNCOMPRESSED_GRAY =  3;
6816   TGA_COMPRESSED_RGB    = 10;
6817   TGA_COMPRESSED_GRAY   = 11;
6818
6819   TGA_NONE_COLOR_TABLE  = 0;
6820
6821 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6822 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6823 var
6824   Header: TTGAHeader;
6825   ImageData: System.PByte;
6826   StartPosition: Int64;
6827   PixelSize, LineSize: Integer;
6828   tgaFormat: TglBitmapFormat;
6829   FormatDesc: TFormatDescriptor;
6830   Counter: packed record
6831     X, Y: packed record
6832       low, high, dir: Integer;
6833     end;
6834   end;
6835
6836 const
6837   CACHE_SIZE = $4000;
6838
6839   ////////////////////////////////////////////////////////////////////////////////////////
6840   procedure ReadUncompressed;
6841   var
6842     i, j: Integer;
6843     buf, tmp1, tmp2: System.PByte;
6844   begin
6845     buf := nil;
6846     if (Counter.X.dir < 0) then
6847       buf := GetMem(LineSize);
6848     try
6849       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
6850         tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
6851         if (Counter.X.dir < 0) then begin               //flip X
6852           aStream.Read(buf^, LineSize);
6853           tmp2 := buf + LineSize - PixelSize;           //pointer to last pixel in line
6854           for i := 0 to Header.Width-1 do begin         //for all pixels in line
6855             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
6856               tmp1^ := tmp2^;
6857               inc(tmp1);
6858               inc(tmp2);
6859             end;
6860             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
6861           end;
6862         end else
6863           aStream.Read(tmp1^, LineSize);
6864         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
6865       end;
6866     finally
6867       if Assigned(buf) then
6868         FreeMem(buf);
6869     end;
6870   end;
6871
6872   ////////////////////////////////////////////////////////////////////////////////////////
6873   procedure ReadCompressed;
6874
6875     /////////////////////////////////////////////////////////////////
6876     var
6877       TmpData: System.PByte;
6878       LinePixelsRead: Integer;
6879     procedure CheckLine;
6880     begin
6881       if (LinePixelsRead >= Header.Width) then begin
6882         LinePixelsRead := 0;
6883         inc(Counter.Y.low, Counter.Y.dir);                //next line index
6884         TmpData := ImageData + Counter.Y.low * LineSize;  //set line
6885         if (Counter.X.dir < 0) then                       //if x flipped then
6886           TmpData := TmpData + LineSize - PixelSize;      //set last pixel
6887       end;
6888     end;
6889
6890     /////////////////////////////////////////////////////////////////
6891     var
6892       Cache: PByte;
6893       CacheSize, CachePos: Integer;
6894     procedure CachedRead(out Buffer; Count: Integer);
6895     var
6896       BytesRead: Integer;
6897     begin
6898       if (CachePos + Count > CacheSize) then begin
6899         //if buffer overflow save non read bytes
6900         BytesRead := 0;
6901         if (CacheSize - CachePos > 0) then begin
6902           BytesRead := CacheSize - CachePos;
6903           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
6904           inc(CachePos, BytesRead);
6905         end;
6906
6907         //load cache from file
6908         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6909         aStream.Read(Cache^, CacheSize);
6910         CachePos := 0;
6911
6912         //read rest of requested bytes
6913         if (Count - BytesRead > 0) then begin
6914           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6915           inc(CachePos, Count - BytesRead);
6916         end;
6917       end else begin
6918         //if no buffer overflow just read the data
6919         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6920         inc(CachePos, Count);
6921       end;
6922     end;
6923
6924     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6925     begin
6926       case PixelSize of
6927         1: begin
6928           aBuffer^ := aData^;
6929           inc(aBuffer, Counter.X.dir);
6930         end;
6931         2: begin
6932           PWord(aBuffer)^ := PWord(aData)^;
6933           inc(aBuffer, 2 * Counter.X.dir);
6934         end;
6935         3: begin
6936           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6937           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6938           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6939           inc(aBuffer, 3 * Counter.X.dir);
6940         end;
6941         4: begin
6942           PCardinal(aBuffer)^ := PCardinal(aData)^;
6943           inc(aBuffer, 4 * Counter.X.dir);
6944         end;
6945       end;
6946     end;
6947
6948   var
6949     TotalPixelsToRead, TotalPixelsRead: Integer;
6950     Temp: Byte;
6951     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6952     PixelRepeat: Boolean;
6953     PixelsToRead, PixelCount: Integer;
6954   begin
6955     CacheSize := 0;
6956     CachePos  := 0;
6957
6958     TotalPixelsToRead := Header.Width * Header.Height;
6959     TotalPixelsRead   := 0;
6960     LinePixelsRead    := 0;
6961
6962     GetMem(Cache, CACHE_SIZE);
6963     try
6964       TmpData := ImageData + Counter.Y.low * LineSize;  //set line
6965       if (Counter.X.dir < 0) then                       //if x flipped then
6966         TmpData := TmpData + LineSize - PixelSize;      //set last pixel
6967
6968       repeat
6969         //read CommandByte
6970         CachedRead(Temp, 1);
6971         PixelRepeat  := (Temp and $80) > 0;
6972         PixelsToRead := (Temp and $7F) + 1;
6973         inc(TotalPixelsRead, PixelsToRead);
6974
6975         if PixelRepeat then
6976           CachedRead(buf[0], PixelSize);
6977         while (PixelsToRead > 0) do begin
6978           CheckLine;
6979           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6980           while (PixelCount > 0) do begin
6981             if not PixelRepeat then
6982               CachedRead(buf[0], PixelSize);
6983             PixelToBuffer(@buf[0], TmpData);
6984             inc(LinePixelsRead);
6985             dec(PixelsToRead);
6986             dec(PixelCount);
6987           end;
6988         end;
6989       until (TotalPixelsRead >= TotalPixelsToRead);
6990     finally
6991       FreeMem(Cache);
6992     end;
6993   end;
6994
6995   function IsGrayFormat: Boolean;
6996   begin
6997     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6998   end;
6999
7000 begin
7001   result := false;
7002
7003   // reading header to test file and set cursor back to begin
7004   StartPosition := aStream.Position;
7005   aStream.Read(Header{%H-}, SizeOf(Header));
7006
7007   // no colormapped files
7008   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7009     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7010   begin
7011     try
7012       if Header.ImageID <> 0 then       // skip image ID
7013         aStream.Position := aStream.Position + Header.ImageID;
7014
7015       case Header.Bpp of
7016          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7017                0: tgaFormat := tfLuminance8;
7018                8: tgaFormat := tfAlpha8;
7019             end;
7020
7021         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7022                0: tgaFormat := tfLuminance16;
7023                8: tgaFormat := tfLuminance8Alpha8;
7024             end else case (Header.ImageDesc and $F) of
7025                0: tgaFormat := tfBGR5;
7026                1: tgaFormat := tfBGR5A1;
7027                4: tgaFormat := tfBGRA4;
7028             end;
7029
7030         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7031                0: tgaFormat := tfBGR8;
7032             end;
7033
7034         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7035                2: tgaFormat := tfBGR10A2;
7036                8: tgaFormat := tfBGRA8;
7037             end;
7038       end;
7039
7040       if (tgaFormat = tfEmpty) then
7041         raise EglBitmapException.Create('LoadTga - unsupported format');
7042
7043       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7044       PixelSize  := FormatDesc.GetSize(1, 1);
7045       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7046
7047       GetMem(ImageData, LineSize * Header.Height);
7048       try
7049         //column direction
7050         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7051           Counter.X.low  := Header.Height-1;;
7052           Counter.X.high := 0;
7053           Counter.X.dir  := -1;
7054         end else begin
7055           Counter.X.low  := 0;
7056           Counter.X.high := Header.Height-1;
7057           Counter.X.dir  := 1;
7058         end;
7059
7060         // Row direction
7061         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7062           Counter.Y.low  := 0;
7063           Counter.Y.high := Header.Height-1;
7064           Counter.Y.dir  := 1;
7065         end else begin
7066           Counter.Y.low  := Header.Height-1;;
7067           Counter.Y.high := 0;
7068           Counter.Y.dir  := -1;
7069         end;
7070
7071         // Read Image
7072         case Header.ImageType of
7073           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7074             ReadUncompressed;
7075           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7076             ReadCompressed;
7077         end;
7078
7079         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
7080         result := true;
7081       except
7082         FreeMem(ImageData);
7083         raise;
7084       end;
7085     finally
7086       aStream.Position := StartPosition;
7087     end;
7088   end
7089     else aStream.Position := StartPosition;
7090 end;
7091
7092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7093 procedure TglBitmap.SaveTGA(const aStream: TStream);
7094 var
7095   Header: TTGAHeader;
7096   LineSize, Size, x, y: Integer;
7097   Pixel: TglBitmapPixelData;
7098   LineBuf, SourceData, DestData: PByte;
7099   SourceMD, DestMD: Pointer;
7100   FormatDesc: TFormatDescriptor;
7101   Converter: TFormatDescriptor;
7102 begin
7103   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7104     raise EglBitmapUnsupportedFormat.Create(Format);
7105
7106   //prepare header
7107   FillChar(Header{%H-}, SizeOf(Header), 0);
7108
7109   //set ImageType
7110   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7111                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7112     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7113   else
7114     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7115
7116   //set BitsPerPixel
7117   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7118     Header.Bpp := 8
7119   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7120                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7121     Header.Bpp := 16
7122   else if (Format in [tfBGR8, tfRGB8]) then
7123     Header.Bpp := 24
7124   else
7125     Header.Bpp := 32;
7126
7127   //set AlphaBitCount
7128   case Format of
7129     tfRGB5A1, tfBGR5A1:
7130       Header.ImageDesc := 1 and $F;
7131     tfRGB10A2, tfBGR10A2:
7132       Header.ImageDesc := 2 and $F;
7133     tfRGBA4, tfBGRA4:
7134       Header.ImageDesc := 4 and $F;
7135     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7136       Header.ImageDesc := 8 and $F;
7137   end;
7138
7139   Header.Width     := Width;
7140   Header.Height    := Height;
7141   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7142   aStream.Write(Header, SizeOf(Header));
7143
7144   // convert RGB(A) to BGR(A)
7145   Converter  := nil;
7146   FormatDesc := TFormatDescriptor.Get(Format);
7147   Size       := FormatDesc.GetSize(Dimension);
7148   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7149     if (FormatDesc.RGBInverted = tfEmpty) then
7150       raise EglBitmapException.Create('inverted RGB format is empty');
7151     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7152     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7153        (Converter.PixelSize <> FormatDesc.PixelSize) then
7154       raise EglBitmapException.Create('invalid inverted RGB format');
7155   end;
7156
7157   if Assigned(Converter) then begin
7158     LineSize := FormatDesc.GetSize(Width, 1);
7159     LineBuf  := GetMem(LineSize);
7160     SourceMD := FormatDesc.CreateMappingData;
7161     DestMD   := Converter.CreateMappingData;
7162     try
7163       SourceData := Data;
7164       for y := 0 to Height-1 do begin
7165         DestData := LineBuf;
7166         for x := 0 to Width-1 do begin
7167           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7168           Converter.Map(Pixel, DestData, DestMD);
7169         end;
7170         aStream.Write(LineBuf^, LineSize);
7171       end;
7172     finally
7173       FreeMem(LineBuf);
7174       FormatDesc.FreeMappingData(SourceMD);
7175       FormatDesc.FreeMappingData(DestMD);
7176     end;
7177   end else
7178     aStream.Write(Data^, Size);
7179 end;
7180
7181 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7182 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7184 const
7185   DDS_MAGIC: Cardinal         = $20534444;
7186
7187   // DDS_header.dwFlags
7188   DDSD_CAPS                   = $00000001;
7189   DDSD_HEIGHT                 = $00000002;
7190   DDSD_WIDTH                  = $00000004;
7191   DDSD_PIXELFORMAT            = $00001000;
7192
7193   // DDS_header.sPixelFormat.dwFlags
7194   DDPF_ALPHAPIXELS            = $00000001;
7195   DDPF_ALPHA                  = $00000002;
7196   DDPF_FOURCC                 = $00000004;
7197   DDPF_RGB                    = $00000040;
7198   DDPF_LUMINANCE              = $00020000;
7199
7200   // DDS_header.sCaps.dwCaps1
7201   DDSCAPS_TEXTURE             = $00001000;
7202
7203   // DDS_header.sCaps.dwCaps2
7204   DDSCAPS2_CUBEMAP            = $00000200;
7205
7206   D3DFMT_DXT1                 = $31545844;
7207   D3DFMT_DXT3                 = $33545844;
7208   D3DFMT_DXT5                 = $35545844;
7209
7210 type
7211   TDDSPixelFormat = packed record
7212     dwSize: Cardinal;
7213     dwFlags: Cardinal;
7214     dwFourCC: Cardinal;
7215     dwRGBBitCount: Cardinal;
7216     dwRBitMask: Cardinal;
7217     dwGBitMask: Cardinal;
7218     dwBBitMask: Cardinal;
7219     dwABitMask: Cardinal;
7220   end;
7221
7222   TDDSCaps = packed record
7223     dwCaps1: Cardinal;
7224     dwCaps2: Cardinal;
7225     dwDDSX: Cardinal;
7226     dwReserved: Cardinal;
7227   end;
7228
7229   TDDSHeader = packed record
7230     dwSize: Cardinal;
7231     dwFlags: Cardinal;
7232     dwHeight: Cardinal;
7233     dwWidth: Cardinal;
7234     dwPitchOrLinearSize: Cardinal;
7235     dwDepth: Cardinal;
7236     dwMipMapCount: Cardinal;
7237     dwReserved: array[0..10] of Cardinal;
7238     PixelFormat: TDDSPixelFormat;
7239     Caps: TDDSCaps;
7240     dwReserved2: Cardinal;
7241   end;
7242
7243 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7244 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7245 var
7246   Header: TDDSHeader;
7247   Converter: TbmpBitfieldFormat;
7248
7249   function GetDDSFormat: TglBitmapFormat;
7250   var
7251     fd: TFormatDescriptor;
7252     i: Integer;
7253     Range: TglBitmapColorRec;
7254     match: Boolean;
7255   begin
7256     result := tfEmpty;
7257     with Header.PixelFormat do begin
7258       // Compresses
7259       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7260         case Header.PixelFormat.dwFourCC of
7261           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7262           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7263           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7264         end;
7265       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7266
7267         //find matching format
7268         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7269           fd := TFormatDescriptor.Get(result);
7270           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7271              (8 * fd.PixelSize = dwRGBBitCount) then
7272             exit;
7273         end;
7274
7275         //find format with same Range
7276         Range.r := dwRBitMask;
7277         Range.g := dwGBitMask;
7278         Range.b := dwBBitMask;
7279         Range.a := dwABitMask;
7280         for i := 0 to 3 do begin
7281           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7282             Range.arr[i] := Range.arr[i] shr 1;
7283         end;
7284         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7285           fd := TFormatDescriptor.Get(result);
7286           match := true;
7287           for i := 0 to 3 do
7288             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7289               match := false;
7290               break;
7291             end;
7292           if match then
7293             break;
7294         end;
7295
7296         //no format with same range found -> use default
7297         if (result = tfEmpty) then begin
7298           if (dwABitMask > 0) then
7299             result := tfBGRA8
7300           else
7301             result := tfBGR8;
7302         end;
7303
7304         Converter := TbmpBitfieldFormat.Create;
7305         Converter.RedMask   := dwRBitMask;
7306         Converter.GreenMask := dwGBitMask;
7307         Converter.BlueMask  := dwBBitMask;
7308         Converter.AlphaMask := dwABitMask;
7309         Converter.PixelSize := dwRGBBitCount / 8;
7310       end;
7311     end;
7312   end;
7313
7314 var
7315   StreamPos: Int64;
7316   x, y, LineSize, RowSize, Magic: Cardinal;
7317   NewImage, TmpData, RowData, SrcData: System.PByte;
7318   SourceMD, DestMD: Pointer;
7319   Pixel: TglBitmapPixelData;
7320   ddsFormat: TglBitmapFormat;
7321   FormatDesc: TFormatDescriptor;
7322
7323 begin
7324   result    := false;
7325   Converter := nil;
7326   StreamPos := aStream.Position;
7327
7328   // Magic
7329   aStream.Read(Magic{%H-}, sizeof(Magic));
7330   if (Magic <> DDS_MAGIC) then begin
7331     aStream.Position := StreamPos;
7332     exit;
7333   end;
7334
7335   //Header
7336   aStream.Read(Header{%H-}, sizeof(Header));
7337   if (Header.dwSize <> SizeOf(Header)) or
7338      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7339         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7340   begin
7341     aStream.Position := StreamPos;
7342     exit;
7343   end;
7344
7345   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7346     raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
7347
7348   ddsFormat := GetDDSFormat;
7349   try
7350     if (ddsFormat = tfEmpty) then
7351       raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7352
7353     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7354     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7355     GetMem(NewImage, Header.dwHeight * LineSize);
7356     try
7357       TmpData := NewImage;
7358
7359       //Converter needed
7360       if Assigned(Converter) then begin
7361         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7362         GetMem(RowData, RowSize);
7363         SourceMD := Converter.CreateMappingData;
7364         DestMD   := FormatDesc.CreateMappingData;
7365         try
7366           for y := 0 to Header.dwHeight-1 do begin
7367             TmpData := NewImage + y * LineSize;
7368             SrcData := RowData;
7369             aStream.Read(SrcData^, RowSize);
7370             for x := 0 to Header.dwWidth-1 do begin
7371               Converter.Unmap(SrcData, Pixel, SourceMD);
7372               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7373               FormatDesc.Map(Pixel, TmpData, DestMD);
7374             end;
7375           end;
7376         finally
7377           Converter.FreeMappingData(SourceMD);
7378           FormatDesc.FreeMappingData(DestMD);
7379           FreeMem(RowData);
7380         end;
7381       end else
7382
7383       // Compressed
7384       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7385         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7386         for Y := 0 to Header.dwHeight-1 do begin
7387           aStream.Read(TmpData^, RowSize);
7388           Inc(TmpData, LineSize);
7389         end;
7390       end else
7391
7392       // Uncompressed
7393       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7394         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7395         for Y := 0 to Header.dwHeight-1 do begin
7396           aStream.Read(TmpData^, RowSize);
7397           Inc(TmpData, LineSize);
7398         end;
7399       end else
7400         raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7401
7402       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
7403       result := true;
7404     except
7405       FreeMem(NewImage);
7406       raise;
7407     end;
7408   finally
7409     FreeAndNil(Converter);
7410   end;
7411 end;
7412
7413 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7414 procedure TglBitmap.SaveDDS(const aStream: TStream);
7415 var
7416   Header: TDDSHeader;
7417   FormatDesc: TFormatDescriptor;
7418 begin
7419   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7420     raise EglBitmapUnsupportedFormat.Create(Format);
7421
7422   FormatDesc := TFormatDescriptor.Get(Format);
7423
7424   // Generell
7425   FillChar(Header{%H-}, SizeOf(Header), 0);
7426   Header.dwSize  := SizeOf(Header);
7427   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7428
7429   Header.dwWidth  := Max(1, Width);
7430   Header.dwHeight := Max(1, Height);
7431
7432   // Caps
7433   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7434
7435   // Pixelformat
7436   Header.PixelFormat.dwSize := sizeof(Header);
7437   if (FormatDesc.IsCompressed) then begin
7438     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7439     case Format of
7440       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7441       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7442       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7443     end;
7444   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7445     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7446     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7447     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7448   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7449     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7450     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7451     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7452     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7453   end else begin
7454     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7455     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7456     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7457     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7458     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7459     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7460   end;
7461
7462   if (FormatDesc.HasAlpha) then
7463     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7464
7465   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7466   aStream.Write(Header, SizeOf(Header));
7467   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7468 end;
7469
7470 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7471 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7472 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7473 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7474 begin
7475   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7476     result := fLines[aIndex]
7477   else
7478     result := nil;
7479 end;
7480
7481 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7482 procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
7483   const aWidth: Integer; const aHeight: Integer);
7484 var
7485   Idx, LineWidth: Integer;
7486 begin
7487   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7488
7489   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7490     // Assigning Data
7491     if Assigned(Data) then begin
7492       SetLength(fLines, GetHeight);
7493       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7494
7495       for Idx := 0 to GetHeight-1 do begin
7496         fLines[Idx] := Data;
7497         Inc(fLines[Idx], Idx * LineWidth);
7498       end;
7499     end
7500       else SetLength(fLines, 0);
7501   end else begin
7502     SetLength(fLines, 0);
7503   end;
7504 end;
7505
7506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7507 procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
7508 var
7509   FormatDesc: TFormatDescriptor;
7510 begin
7511   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7512
7513   FormatDesc := TFormatDescriptor.Get(Format);
7514   if FormatDesc.IsCompressed then begin
7515     glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7516   end else if aBuildWithGlu then begin
7517     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7518       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7519   end else begin
7520     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7521       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7522   end;
7523
7524   // Freigeben
7525   if (FreeDataAfterGenTexture) then
7526     FreeData;
7527 end;
7528
7529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7530 procedure TglBitmap2D.AfterConstruction;
7531 begin
7532   inherited;
7533   Target := GL_TEXTURE_2D;
7534 end;
7535
7536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7537 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7538 var
7539   Temp: pByte;
7540   Size, w, h: Integer;
7541   FormatDesc: TFormatDescriptor;
7542 begin
7543   FormatDesc := TFormatDescriptor.Get(Format);
7544   if FormatDesc.IsCompressed then
7545     raise EglBitmapUnsupportedFormat.Create(Format);
7546
7547   w    := aRight  - aLeft;
7548   h    := aBottom - aTop;
7549   Size := FormatDesc.GetSize(w, h);
7550   GetMem(Temp, Size);
7551   try
7552     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7553     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7554     SetDataPointer(Temp, Format, w, h);
7555     FlipVert;
7556   except
7557     FreeMem(Temp);
7558     raise;
7559   end;
7560 end;
7561
7562 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7563 procedure TglBitmap2D.GetDataFromTexture;
7564 var
7565   Temp: PByte;
7566   TempWidth, TempHeight: Integer;
7567   TempIntFormat: Cardinal;
7568   IntFormat, f: TglBitmapFormat;
7569   FormatDesc: TFormatDescriptor;
7570 begin
7571   Bind;
7572
7573   // Request Data
7574   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7575   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7576   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7577
7578   IntFormat := tfEmpty;
7579   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7580     FormatDesc := TFormatDescriptor.Get(f);
7581     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7582       IntFormat := FormatDesc.Format;
7583       break;
7584     end;
7585   end;
7586
7587   // Getting data from OpenGL
7588   FormatDesc := TFormatDescriptor.Get(IntFormat);
7589   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7590   try
7591     if FormatDesc.IsCompressed then
7592       glGetCompressedTexImage(Target, 0, Temp)
7593     else
7594      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7595     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
7596   except
7597     FreeMem(Temp);
7598     raise;
7599   end;
7600 end;
7601
7602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7603 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7604 var
7605   BuildWithGlu, PotTex, TexRec: Boolean;
7606   TexSize: Integer;
7607 begin
7608   if Assigned(Data) then begin
7609     // Check Texture Size
7610     if (aTestTextureSize) then begin
7611       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7612
7613       if ((Height > TexSize) or (Width > TexSize)) then
7614         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7615
7616       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7617       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
7618
7619       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7620         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7621     end;
7622
7623     CreateId;
7624     SetupParameters(BuildWithGlu);
7625     UploadData(Target, BuildWithGlu);
7626     glAreTexturesResident(1, @fID, @fIsResident);
7627   end;
7628 end;
7629
7630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7631 function TglBitmap2D.FlipHorz: Boolean;
7632 var
7633   Col, Row: Integer;
7634   TempDestData, DestData, SourceData: PByte;
7635   ImgSize: Integer;
7636 begin
7637   result := inherited FlipHorz;
7638   if Assigned(Data) then begin
7639     SourceData := Data;
7640     ImgSize := Height * fRowSize;
7641     GetMem(DestData, ImgSize);
7642     try
7643       TempDestData := DestData;
7644       Dec(TempDestData, fRowSize + fPixelSize);
7645       for Row := 0 to Height -1 do begin
7646         Inc(TempDestData, fRowSize * 2);
7647         for Col := 0 to Width -1 do begin
7648           Move(SourceData^, TempDestData^, fPixelSize);
7649           Inc(SourceData, fPixelSize);
7650           Dec(TempDestData, fPixelSize);
7651         end;
7652       end;
7653       SetDataPointer(DestData, Format);
7654       result := true;
7655     except
7656       FreeMem(DestData);
7657       raise;
7658     end;
7659   end;
7660 end;
7661
7662 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7663 function TglBitmap2D.FlipVert: Boolean;
7664 var
7665   Row: Integer;
7666   TempDestData, DestData, SourceData: PByte;
7667 begin
7668   result := inherited FlipVert;
7669   if Assigned(Data) then begin
7670     SourceData := Data;
7671     GetMem(DestData, Height * fRowSize);
7672     try
7673       TempDestData := DestData;
7674       Inc(TempDestData, Width * (Height -1) * fPixelSize);
7675       for Row := 0 to Height -1 do begin
7676         Move(SourceData^, TempDestData^, fRowSize);
7677         Dec(TempDestData, fRowSize);
7678         Inc(SourceData, fRowSize);
7679       end;
7680       SetDataPointer(DestData, Format);
7681       result := true;
7682     except
7683       FreeMem(DestData);
7684       raise;
7685     end;
7686   end;
7687 end;
7688
7689 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7690 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7691 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7692 type
7693   TMatrixItem = record
7694     X, Y: Integer;
7695     W: Single;
7696   end;
7697
7698   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7699   TglBitmapToNormalMapRec = Record
7700     Scale: Single;
7701     Heights: array of Single;
7702     MatrixU : array of TMatrixItem;
7703     MatrixV : array of TMatrixItem;
7704   end;
7705
7706 const
7707   ONE_OVER_255 = 1 / 255;
7708
7709   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7710 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7711 var
7712   Val: Single;
7713 begin
7714   with FuncRec do begin
7715     Val :=
7716       Source.Data.r * LUMINANCE_WEIGHT_R +
7717       Source.Data.g * LUMINANCE_WEIGHT_G +
7718       Source.Data.b * LUMINANCE_WEIGHT_B;
7719     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7720   end;
7721 end;
7722
7723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7724 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7725 begin
7726   with FuncRec do
7727     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7728 end;
7729
7730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7731 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7732 type
7733   TVec = Array[0..2] of Single;
7734 var
7735   Idx: Integer;
7736   du, dv: Double;
7737   Len: Single;
7738   Vec: TVec;
7739
7740   function GetHeight(X, Y: Integer): Single;
7741   begin
7742     with FuncRec do begin
7743       X := Max(0, Min(Size.X -1, X));
7744       Y := Max(0, Min(Size.Y -1, Y));
7745       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7746     end;
7747   end;
7748
7749 begin
7750   with FuncRec do begin
7751     with PglBitmapToNormalMapRec(Args)^ do begin
7752       du := 0;
7753       for Idx := Low(MatrixU) to High(MatrixU) do
7754         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7755
7756       dv := 0;
7757       for Idx := Low(MatrixU) to High(MatrixU) do
7758         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7759
7760       Vec[0] := -du * Scale;
7761       Vec[1] := -dv * Scale;
7762       Vec[2] := 1;
7763     end;
7764
7765     // Normalize
7766     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7767     if Len <> 0 then begin
7768       Vec[0] := Vec[0] * Len;
7769       Vec[1] := Vec[1] * Len;
7770       Vec[2] := Vec[2] * Len;
7771     end;
7772
7773     // Farbe zuweisem
7774     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7775     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7776     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7777   end;
7778 end;
7779
7780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7781 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7782 var
7783   Rec: TglBitmapToNormalMapRec;
7784
7785   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7786   begin
7787     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7788       Matrix[Index].X := X;
7789       Matrix[Index].Y := Y;
7790       Matrix[Index].W := W;
7791     end;
7792   end;
7793
7794 begin
7795   if TFormatDescriptor.Get(Format).IsCompressed then
7796     raise EglBitmapUnsupportedFormat.Create(Format);
7797
7798   if aScale > 100 then
7799     Rec.Scale := 100
7800   else if aScale < -100 then
7801     Rec.Scale := -100
7802   else
7803     Rec.Scale := aScale;
7804
7805   SetLength(Rec.Heights, Width * Height);
7806   try
7807     case aFunc of
7808       nm4Samples: begin
7809         SetLength(Rec.MatrixU, 2);
7810         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7811         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7812
7813         SetLength(Rec.MatrixV, 2);
7814         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7815         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7816       end;
7817
7818       nmSobel: begin
7819         SetLength(Rec.MatrixU, 6);
7820         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7821         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7822         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7823         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7824         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7825         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7826
7827         SetLength(Rec.MatrixV, 6);
7828         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7829         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7830         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7831         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7832         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7833         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7834       end;
7835
7836       nm3x3: begin
7837         SetLength(Rec.MatrixU, 6);
7838         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7839         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7840         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7841         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7842         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7843         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7844
7845         SetLength(Rec.MatrixV, 6);
7846         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7847         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7848         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7849         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7850         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7851         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7852       end;
7853
7854       nm5x5: begin
7855         SetLength(Rec.MatrixU, 20);
7856         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7857         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7858         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7859         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7860         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7861         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7862         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7863         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7864         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7865         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7866         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7867         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7868         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7869         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7870         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7871         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7872         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7873         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7874         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7875         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7876
7877         SetLength(Rec.MatrixV, 20);
7878         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7879         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7880         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7881         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7882         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7883         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7884         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7885         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7886         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7887         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7888         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7889         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7890         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7891         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7892         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7893         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7894         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7895         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7896         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7897         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7898       end;
7899     end;
7900
7901     // Daten Sammeln
7902     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7903       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7904     else
7905       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
7906     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
7907   finally
7908     SetLength(Rec.Heights, 0);
7909   end;
7910 end;
7911
7912
7913
7914
7915
7916
7917
7918
7919
7920 (*
7921 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
7922 var
7923   pTemp: pByte;
7924   Size: Integer;
7925 begin
7926   if Height > 1 then begin
7927     // extract first line of the data
7928     Size := FormatGetImageSize(glBitmapPosition(Width), Format);
7929     GetMem(pTemp, Size);
7930
7931     Move(Data^, pTemp^, Size);
7932
7933     FreeMem(Data);
7934   end else
7935     pTemp := Data;
7936
7937   // set data pointer
7938   inherited SetDataPointer(pTemp, Format, Width);
7939
7940   if FormatIsUncompressed(Format) then begin
7941     fUnmapFunc := FormatGetUnMapFunc(Format);
7942     fGetPixelFunc := GetPixel1DUnmap;
7943   end;
7944 end;
7945
7946
7947 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
7948 var
7949   pTemp: pByte;
7950 begin
7951   pTemp := Data;
7952   Inc(pTemp, Pos.X * fPixelSize);
7953
7954   fUnmapFunc(pTemp, Pixel);
7955 end;
7956
7957
7958 function TglBitmap1D.FlipHorz: Boolean;
7959 var
7960   Col: Integer;
7961   pTempDest, pDest, pSource: pByte;
7962 begin
7963   result := inherited FlipHorz;
7964
7965   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
7966     pSource := Data;
7967
7968     GetMem(pDest, fRowSize);
7969     try
7970       pTempDest := pDest;
7971
7972       Inc(pTempDest, fRowSize);
7973       for Col := 0 to Width -1 do begin
7974         Move(pSource^, pTempDest^, fPixelSize);
7975
7976         Inc(pSource, fPixelSize);
7977         Dec(pTempDest, fPixelSize);
7978       end;
7979
7980       SetDataPointer(pDest, InternalFormat);
7981
7982       result := true;
7983     finally
7984       FreeMem(pDest);
7985     end;
7986   end;
7987 end;
7988
7989
7990 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
7991 begin
7992   // Upload data
7993   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
7994     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
7995   else
7996
7997   // Upload data
7998   if BuildWithGlu then
7999     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
8000   else
8001     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
8002
8003   // Freigeben
8004   if (FreeDataAfterGenTexture) then
8005     FreeData;
8006 end;
8007
8008
8009 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
8010 var
8011   BuildWithGlu, TexRec: Boolean;
8012   glFormat, glInternalFormat, glType: Cardinal;
8013   TexSize: Integer;
8014 begin
8015   if Assigned(Data) then begin
8016     // Check Texture Size
8017     if (TestTextureSize) then begin
8018       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8019
8020       if (Width > TexSize) then
8021         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8022
8023       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8024                 (Target = GL_TEXTURE_RECTANGLE_ARB);
8025
8026       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8027         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8028     end;
8029
8030     CreateId;
8031
8032     SetupParameters(BuildWithGlu);
8033     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8034
8035     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
8036
8037     // Infos sammeln
8038     glAreTexturesResident(1, @fID, @fIsResident);
8039   end;
8040 end;
8041
8042
8043 procedure TglBitmap1D.AfterConstruction;
8044 begin
8045   inherited;
8046
8047   Target := GL_TEXTURE_1D;
8048 end;
8049
8050
8051 { TglBitmapCubeMap }
8052
8053 procedure TglBitmapCubeMap.AfterConstruction;
8054 begin
8055   inherited;
8056
8057   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8058     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8059
8060   SetWrap; // set all to GL_CLAMP_TO_EDGE
8061   Target := GL_TEXTURE_CUBE_MAP;
8062   fGenMode := GL_REFLECTION_MAP;
8063 end;
8064
8065
8066 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
8067 begin
8068   inherited Bind (EnableTextureUnit);
8069
8070   if EnableTexCoordsGen then begin
8071     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8072     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8073     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8074     glEnable(GL_TEXTURE_GEN_S);
8075     glEnable(GL_TEXTURE_GEN_T);
8076     glEnable(GL_TEXTURE_GEN_R);
8077   end;
8078 end;
8079
8080
8081 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
8082 var
8083   glFormat, glInternalFormat, glType: Cardinal;
8084   BuildWithGlu: Boolean;
8085   TexSize: Integer;
8086 begin
8087   // Check Texture Size
8088   if (TestTextureSize) then begin
8089     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8090
8091     if ((Height > TexSize) or (Width > TexSize)) then
8092       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8093
8094     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8095       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8096   end;
8097
8098   // create Texture
8099   if ID = 0 then begin
8100     CreateID;
8101     SetupParameters(BuildWithGlu);
8102   end;
8103
8104   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8105
8106   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
8107 end;
8108
8109
8110 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
8111 begin
8112   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8113 end;
8114
8115
8116 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
8117   DisableTextureUnit: Boolean);
8118 begin
8119   inherited Unbind (DisableTextureUnit);
8120
8121   if DisableTexCoordsGen then begin
8122     glDisable(GL_TEXTURE_GEN_S);
8123     glDisable(GL_TEXTURE_GEN_T);
8124     glDisable(GL_TEXTURE_GEN_R);
8125   end;
8126 end;
8127
8128
8129 { TglBitmapNormalMap }
8130
8131 type
8132   TVec = Array[0..2] of Single;
8133   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8134
8135   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8136   TglBitmapNormalMapRec = record
8137     HalfSize : Integer;
8138     Func: TglBitmapNormalMapGetVectorFunc;
8139   end;
8140
8141
8142 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8143 begin
8144   Vec[0] := HalfSize;
8145   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8146   Vec[2] := - (Position.X + 0.5 - HalfSize);
8147 end;
8148
8149
8150 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8151 begin
8152   Vec[0] := - HalfSize;
8153   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8154   Vec[2] := Position.X + 0.5 - HalfSize;
8155 end;
8156
8157
8158 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8159 begin
8160   Vec[0] := Position.X + 0.5 - HalfSize;
8161   Vec[1] := HalfSize;
8162   Vec[2] := Position.Y + 0.5 - HalfSize;
8163 end;
8164
8165
8166 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8167 begin
8168   Vec[0] := Position.X + 0.5 - HalfSize;
8169   Vec[1] := - HalfSize;
8170   Vec[2] := - (Position.Y + 0.5 - HalfSize);
8171 end;
8172
8173
8174 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8175 begin
8176   Vec[0] := Position.X + 0.5 - HalfSize;
8177   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8178   Vec[2] := HalfSize;
8179 end;
8180
8181
8182 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8183 begin
8184   Vec[0] := - (Position.X + 0.5 - HalfSize);
8185   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8186   Vec[2] := - HalfSize;
8187 end;
8188
8189
8190 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8191 var
8192   Vec : TVec;
8193   Len: Single;
8194 begin
8195   with FuncRec do begin
8196     with PglBitmapNormalMapRec (CustomData)^ do begin
8197       Func(Vec, Position, HalfSize);
8198
8199       // Normalize
8200       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8201       if Len <> 0 then begin
8202         Vec[0] := Vec[0] * Len;
8203         Vec[1] := Vec[1] * Len;
8204         Vec[2] := Vec[2] * Len;
8205       end;
8206
8207       // Scale Vector and AddVectro
8208       Vec[0] := Vec[0] * 0.5 + 0.5;
8209       Vec[1] := Vec[1] * 0.5 + 0.5;
8210       Vec[2] := Vec[2] * 0.5 + 0.5;
8211     end;
8212
8213     // Set Color
8214     Dest.Red   := Round(Vec[0] * 255);
8215     Dest.Green := Round(Vec[1] * 255);
8216     Dest.Blue  := Round(Vec[2] * 255);
8217   end;
8218 end;
8219
8220
8221 procedure TglBitmapNormalMap.AfterConstruction;
8222 begin
8223   inherited;
8224
8225   fGenMode := GL_NORMAL_MAP;
8226 end;
8227
8228
8229 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
8230   TestTextureSize: Boolean);
8231 var
8232   Rec: TglBitmapNormalMapRec;
8233   SizeRec: TglBitmapPixelPosition;
8234 begin
8235   Rec.HalfSize := Size div 2;
8236
8237   FreeDataAfterGenTexture := false;
8238
8239   SizeRec.Fields := [ffX, ffY];
8240   SizeRec.X := Size;
8241   SizeRec.Y := Size;
8242
8243   // Positive X
8244   Rec.Func := glBitmapNormalMapPosX;
8245   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8246   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
8247
8248   // Negative X
8249   Rec.Func := glBitmapNormalMapNegX;
8250   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8251   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
8252
8253   // Positive Y
8254   Rec.Func := glBitmapNormalMapPosY;
8255   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8256   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
8257
8258   // Negative Y
8259   Rec.Func := glBitmapNormalMapNegY;
8260   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8261   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
8262
8263   // Positive Z
8264   Rec.Func := glBitmapNormalMapPosZ;
8265   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8266   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
8267
8268   // Negative Z
8269   Rec.Func := glBitmapNormalMapNegZ;
8270   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8271   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
8272 end;
8273 *)
8274
8275 initialization
8276   glBitmapSetDefaultFormat(tfEmpty);
8277   glBitmapSetDefaultMipmap(mmMipmap);
8278   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8279   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8280
8281   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8282   glBitmapSetDefaultDeleteTextureOnFree    (true);
8283
8284   TFormatDescriptor.Init;
8285
8286 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8287   OpenGLInitialized := false;
8288   InitOpenGLCS := TCriticalSection.Create;
8289 {$ENDIF}
8290
8291 finalization
8292   TFormatDescriptor.Finalize;
8293
8294 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8295   FreeAndNil(InitOpenGLCS);
8296 {$ENDIF}
8297
8298 end.
8299