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/) (2013)
   6
   7 ------------------------------------------------------------
   8 The contents of this file are used with permission, subject to
   9 the Mozilla Public License Version 1.1 (the "License"); you may
  10 not use this file except in compliance with the License. You may
  11 obtain a copy of the License at
  12 http://www.mozilla.org/MPL/MPL-1.1.html
  13 ------------------------------------------------------------
  14 Version 3.0.0 unstable
  15 ------------------------------------------------------------
  16 History
  17 20-11-2013
  18 - refactoring of the complete library
  19 21-03-2010
  20 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  21   then it's your problem if that isn't true. This prevents the unit for incompatibility
  22   with newer versions of Delphi.
  23 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  24 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  25 10-08-2008
  26 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  27 - Additional Datapointer for functioninterface now has the name CustomData
  28 24-07-2008
  29 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  30 - If you load an texture from an file the property Filename will be set to the name of the file
  31 - Three new properties to attach custom data to the Texture objects
  32   - CustomName  (free for use string)
  33   - CustomNameW (free for use widestring)
  34   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  35 27-05-2008
  36 - RLE TGAs loaded much faster
  37 26-05-2008
  38 - fixed some problem with reading RLE TGAs.
  39 21-05-2008
  40 - function clone now only copys data if it's assigned and now it also copies the ID
  41 - it seems that lazarus dont like comments in comments.
  42 01-05-2008
  43 - It's possible to set the id of the texture
  44 - define GLB_NO_NATIVE_GL deactivated by default
  45 27-04-2008
  46 - Now supports the following libraries
  47   - SDL and SDL_image
  48   - libPNG
  49   - libJPEG
  50 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  51 - BMPs now loaded manuel
  52 - Large restructuring
  53 - Property DataPtr now has the name Data
  54 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  55 - Unused Depth removed
  56 - Function FreeData to freeing image data added
  57 24-10-2007
  58 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  59 15-11-2006
  60 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  61 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  62 - Function ReadOpenGLExtension is now only intern
  63 29-06-2006
  64 - pngimage now disabled by default like all other versions.
  65 26-06-2006
  66 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  67 22-06-2006
  68 - Fixed some Problem with Delphi 5
  69 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  70 22-03-2006
  71 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  72 09-03-2006
  73 - Internal Format ifDepth8 added
  74 - function GrabScreen now supports all uncompressed formats
  75 31-01-2006
  76 - AddAlphaFromglBitmap implemented
  77 29-12-2005
  78 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  79 28-12-2005
  80 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  81   property Width, Height, Depth are still existing and new property Dimension are avail
  82 11-12-2005
  83 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  84 19-10-2005
  85 - Added function GrabScreen to class TglBitmap2D
  86 18-10-2005
  87 - Added support to Save images
  88 - Added function Clone to Clone Instance
  89 11-10-2005
  90 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  91   Usefull for Future
  92 - Several speed optimizations
  93 09-10-2005
  94 - Internal structure change. Loading of TGA, PNG and DDS improved.
  95   Data, format and size will now set directly with SetDataPtr.
  96 - AddFunc now works with all Types of Images and Formats
  97 - Some Funtions moved to Baseclass TglBitmap
  98 06-10-2005
  99 - Added Support to decompress DXT3 and DXT5 compressed Images.
 100 - Added Mapping to convert data from one format into an other.
 101 05-10-2005
 102 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 103   supported Input format (supported by GetPixel) into any uncompresed Format
 104 - Added Support to decompress DXT1 compressed Images.
 105 - SwapColors replaced by ConvertTo
 106 04-10-2005
 107 - Added Support for compressed DDSs
 108 - Added new internal formats (DXT1, DXT3, DXT5)
 109 29-09-2005
 110 - Parameter Components renamed to InternalFormat
 111 23-09-2005
 112 - Some AllocMem replaced with GetMem (little speed change)
 113 - better exception handling. Better protection from memory leaks.
 114 22-09-2005
 115 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 116 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 117 07-09-2005
 118 - Added support for Grayscale textures
 119 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 120 10-07-2005
 121 - Added support for GL_VERSION_2_0
 122 - Added support for GL_EXT_texture_filter_anisotropic
 123 04-07-2005
 124 - Function FillWithColor fills the Image with one Color
 125 - Function LoadNormalMap added
 126 30-06-2005
 127 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 128 - ToNormalMap now supports Sobel (nmSobel) function.
 129 29-06-2005
 130 - support for RLE Compressed RGB TGAs added
 131 28-06-2005
 132 - Class TglBitmapNormalMap added to support Normalmap generation
 133 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 134   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 135 16-06-2005
 136 - Method LoadCubeMapClass removed
 137 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 138 - virtual abstract method GenTexture in class TglBitmap now is protected
 139 12-06-2005
 140 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 141 10-06-2005
 142 - little enhancement for IsPowerOfTwo
 143 - TglBitmap1D.GenTexture now tests NPOT Textures
 144 06-06-2005
 145 - some little name changes. All properties or function with Texture in name are
 146   now without texture in name. We have allways texture so we dosn't name it.
 147 03-06-2005
 148 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 149   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 150 02-06-2005
 151 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 152 25-04-2005
 153 - Function Unbind added
 154 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 155 21-04-2005
 156 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 157 29-03-2005
 158 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 159   To Enable png's use the define pngimage
 160 22-03-2005
 161 - New Functioninterface added
 162 - Function GetPixel added
 163 27-11-2004
 164 - Property BuildMipMaps renamed to MipMap
 165 21-11-2004
 166 - property Name removed.
 167 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 168 22-05-2004
 169 - property name added. Only used in glForms!
 170 26-11-2003
 171 - property FreeDataAfterGenTexture is now available as default (default = true)
 172 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 173 - function MoveMemory replaced with function Move (little speed change)
 174 - several calculations stored in variables (little speed change)
 175 29-09-2003
 176 - property BuildMipsMaps added (default = true)
 177   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 178 - property FreeDataAfterGenTexture added (default = true)
 179   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 180 - parameter DisableOtherTextureUnits of Bind removed
 181 - parameter FreeDataAfterGeneration of GenTextures removed
 182 12-09-2003
 183 - TglBitmap dosn't delete data if class was destroyed (fixed)
 184 09-09-2003
 185 - Bind now enables TextureUnits (by params)
 186 - GenTextures can leave data (by param)
 187 - LoadTextures now optimal
 188 03-09-2003
 189 - Performance optimization in AddFunc
 190 - procedure Bind moved to subclasses
 191 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 192 19-08-2003
 193 - Texturefilter and texturewrap now also as defaults
 194   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 195   Magfilter = GL_LINEAR
 196   Wrap(str) = GL_CLAMP_TO_EDGE
 197 - Added new format tfCompressed to create a compressed texture.
 198 - propertys IsCompressed, TextureSize and IsResident added
 199   IsCompressed and TextureSize only contains data from level 0
 200 18-08-2003
 201 - Added function AddFunc to add PerPixelEffects to Image
 202 - LoadFromFunc now based on AddFunc
 203 - Invert now based on AddFunc
 204 - SwapColors now based on AddFunc
 205 16-08-2003
 206 - Added function FlipHorz
 207 15-08-2003
 208 - Added function LaodFromFunc to create images with function
 209 - Added function FlipVert
 210 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 211 29-07-2003
 212 - Added Alphafunctions to calculate alpha per function
 213 - Added Alpha from ColorKey using alphafunctions
 214 28-07-2003
 215 - First full functionally Version of glBitmap
 216 - Support for 24Bit and 32Bit TGA Pictures added
 217 25-07-2003
 218 - begin of programming
 219 ***********************************************************}
 220 unit glBitmap;
 221
 222 // Please uncomment the defines below to configure the glBitmap to your preferences.
 223 // If you have configured the unit you can uncomment the warning above.
 224 {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 225
 226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 229 // activate to enable build-in OpenGL support with statically linked methods
 230 // use dglOpenGL.pas if not enabled
 231 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 232
 233 // activate to enable build-in OpenGL support with dynamically linked methods
 234 // use dglOpenGL.pas if not enabled
 235 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 236
 237
 238 // activate to enable the support for SDL_surfaces
 239 {.$DEFINE GLB_SDL}
 240
 241 // activate  to enable the support for TBitmap from Delphi (not lazarus)
 242 {.$DEFINE GLB_DELPHI}
 243
 244 // activate to enable the support for TLazIntfImage from Lazarus
 245 {$DEFINE GLB_LAZARUS}
 246
 247
 248
 249 // activate to enable the support of SDL_image to load files. (READ ONLY)
 250 // If you enable SDL_image all other libraries will be ignored!
 251 {.$DEFINE GLB_SDL_IMAGE}
 252
 253
 254
 255 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
 256 // if you enable pngimage the libPNG will be ignored
 257 {.$DEFINE GLB_PNGIMAGE}
 258
 259 // activate to use the libPNG -> http://www.libpng.org/
 260 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
 261 {.$DEFINE GLB_LIB_PNG}
 262
 263
 264
 265 // if you enable delphi jpegs the libJPEG will be ignored
 266 {.$DEFINE GLB_DELPHI_JPEG}
 267
 268 // activate to use the libJPEG -> http://www.ijg.org/
 269 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
 270 {.$DEFINE GLB_LIB_JPEG}
 271
 272
 273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 274 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 276 // Delphi Versions
 277 {$IFDEF fpc}
 278   {$MODE Delphi}
 279
 280   {$IFDEF CPUI386}
 281     {$DEFINE CPU386}
 282     {$ASMMODE INTEL}
 283   {$ENDIF}
 284
 285   {$IFNDEF WINDOWS}
 286     {$linklib c}
 287   {$ENDIF}
 288 {$ENDIF}
 289
 290 // Operation System
 291 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
 292   {$DEFINE GLB_WIN}
 293 {$ELSEIF DEFINED(LINUX)}
 294   {$DEFINE GLB_LINUX}
 295 {$IFEND}
 296
 297 // native OpenGL Support
 298 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 299   {$DEFINE GLB_NATIVE_OGL}
 300 {$IFEND}
 301
 302 // checking define combinations
 303 //SDL Image
 304 {$IFDEF GLB_SDL_IMAGE}
 305   {$IFNDEF GLB_SDL}
 306     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 307     {$DEFINE GLB_SDL}
 308   {$ENDIF}
 309   {$IFDEF GLB_PNGIMAGE}
 310     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 311     {$undef GLB_PNGIMAGE}
 312   {$ENDIF}
 313   {$IFDEF GLB_DELPHI_JPEG}
 314     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 315     {$undef GLB_DELPHI_JPEG}
 316   {$ENDIF}
 317   {$IFDEF GLB_LIB_PNG}
 318     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 319     {$undef GLB_LIB_PNG}
 320   {$ENDIF}
 321   {$IFDEF GLB_LIB_JPEG}
 322     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 323     {$undef GLB_LIB_JPEG}
 324   {$ENDIF}
 325
 326   {$DEFINE GLB_SUPPORT_PNG_READ}
 327   {$DEFINE GLB_SUPPORT_JPEG_READ}
 328 {$ENDIF}
 329
 330 // PNG Image
 331 {$IFDEF GLB_PNGIMAGE}
 332   {$IFDEF GLB_LIB_PNG}
 333     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 334     {$undef GLB_LIB_PNG}
 335   {$ENDIF}
 336
 337   {$DEFINE GLB_SUPPORT_PNG_READ}
 338   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 339 {$ENDIF}
 340
 341 // libPNG
 342 {$IFDEF GLB_LIB_PNG}
 343   {$DEFINE GLB_SUPPORT_PNG_READ}
 344   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 345 {$ENDIF}
 346
 347 // JPEG Image
 348 {$IFDEF GLB_DELPHI_JPEG}
 349   {$IFDEF GLB_LIB_JPEG}
 350     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 351     {$undef GLB_LIB_JPEG}
 352   {$ENDIF}
 353
 354   {$DEFINE GLB_SUPPORT_JPEG_READ}
 355   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 356 {$ENDIF}
 357
 358 // libJPEG
 359 {$IFDEF GLB_LIB_JPEG}
 360   {$DEFINE GLB_SUPPORT_JPEG_READ}
 361   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 362 {$ENDIF}
 363
 364 // native OpenGL
 365 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 366   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 367 {$IFEND}
 368
 369 // general options
 370 {$EXTENDEDSYNTAX ON}
 371 {$LONGSTRINGS ON}
 372 {$ALIGN ON}
 373 {$IFNDEF FPC}
 374   {$OPTIMIZATION ON}
 375 {$ENDIF}
 376
 377 interface
 378
 379 uses
 380   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                {$ENDIF}
 381   {$IF DEFINED(GLB_WIN) AND
 382        DEFINED(GLB_NATIVE_OGL)} windows,                  {$IFEND}
 383
 384   {$IFDEF GLB_SDL}              SDL,                      {$ENDIF}
 385   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType,  {$ENDIF}
 386   {$IFDEF GLB_DELPHI}           Dialogs, Graphics,        {$ENDIF}
 387
 388   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                {$ENDIF}
 389   {$IFDEF GLB_PNGIMAGE}         pngimage,                 {$ENDIF}
 390   {$IFDEF GLB_LIB_PNG}          libPNG,                   {$ENDIF}
 391   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                     {$ENDIF}
 392   {$IFDEF GLB_LIB_JPEG}         libJPEG,                  {$ENDIF}
 393
 394   Classes, SysUtils;
 395
 396 {$IFDEF GLB_NATIVE_OGL}
 397 const
 398   GL_TRUE   = 1;
 399   GL_FALSE  = 0;
 400
 401   GL_ZERO = 0;
 402   GL_ONE  = 1;
 403
 404   GL_VERSION    = $1F02;
 405   GL_EXTENSIONS = $1F03;
 406
 407   GL_TEXTURE_1D         = $0DE0;
 408   GL_TEXTURE_2D         = $0DE1;
 409   GL_TEXTURE_RECTANGLE  = $84F5;
 410
 411   GL_NORMAL_MAP                   = $8511;
 412   GL_TEXTURE_CUBE_MAP             = $8513;
 413   GL_REFLECTION_MAP               = $8512;
 414   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;
 415   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;
 416   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;
 417   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;
 418   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;
 419   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;
 420
 421   GL_TEXTURE_WIDTH            = $1000;
 422   GL_TEXTURE_HEIGHT           = $1001;
 423   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 424   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;
 425
 426   GL_S = $2000;
 427   GL_T = $2001;
 428   GL_R = $2002;
 429   GL_Q = $2003;
 430
 431   GL_TEXTURE_GEN_S = $0C60;
 432   GL_TEXTURE_GEN_T = $0C61;
 433   GL_TEXTURE_GEN_R = $0C62;
 434   GL_TEXTURE_GEN_Q = $0C63;
 435
 436   GL_RED    = $1903;
 437   GL_GREEN  = $1904;
 438   GL_BLUE   = $1905;
 439
 440   GL_ALPHA    = $1906;
 441   GL_ALPHA4   = $803B;
 442   GL_ALPHA8   = $803C;
 443   GL_ALPHA12  = $803D;
 444   GL_ALPHA16  = $803E;
 445
 446   GL_LUMINANCE    = $1909;
 447   GL_LUMINANCE4   = $803F;
 448   GL_LUMINANCE8   = $8040;
 449   GL_LUMINANCE12  = $8041;
 450   GL_LUMINANCE16  = $8042;
 451
 452   GL_LUMINANCE_ALPHA      = $190A;
 453   GL_LUMINANCE4_ALPHA4    = $8043;
 454   GL_LUMINANCE6_ALPHA2    = $8044;
 455   GL_LUMINANCE8_ALPHA8    = $8045;
 456   GL_LUMINANCE12_ALPHA4   = $8046;
 457   GL_LUMINANCE12_ALPHA12  = $8047;
 458   GL_LUMINANCE16_ALPHA16  = $8048;
 459
 460   GL_RGB      = $1907;
 461   GL_BGR      = $80E0;
 462   GL_R3_G3_B2 = $2A10;
 463   GL_RGB4     = $804F;
 464   GL_RGB5     = $8050;
 465   GL_RGB565   = $8D62;
 466   GL_RGB8     = $8051;
 467   GL_RGB10    = $8052;
 468   GL_RGB12    = $8053;
 469   GL_RGB16    = $8054;
 470
 471   GL_RGBA     = $1908;
 472   GL_BGRA     = $80E1;
 473   GL_RGBA2    = $8055;
 474   GL_RGBA4    = $8056;
 475   GL_RGB5_A1  = $8057;
 476   GL_RGBA8    = $8058;
 477   GL_RGB10_A2 = $8059;
 478   GL_RGBA12   = $805A;
 479   GL_RGBA16   = $805B;
 480
 481   GL_DEPTH_COMPONENT    = $1902;
 482   GL_DEPTH_COMPONENT16  = $81A5;
 483   GL_DEPTH_COMPONENT24  = $81A6;
 484   GL_DEPTH_COMPONENT32  = $81A7;
 485
 486   GL_COMPRESSED_RGB                 = $84ED;
 487   GL_COMPRESSED_RGBA                = $84EE;
 488   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 489   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 490   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 491   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 492
 493   GL_UNSIGNED_BYTE            = $1401;
 494   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 495   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 496
 497   GL_UNSIGNED_SHORT             = $1403;
 498   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 499   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 500   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 501   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 502   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 503   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 504
 505   GL_UNSIGNED_INT                 = $1405;
 506   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 507   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 508   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 509   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 510
 511   { Texture Filter }
 512   GL_TEXTURE_MAG_FILTER     = $2800;
 513   GL_TEXTURE_MIN_FILTER     = $2801;
 514   GL_NEAREST                = $2600;
 515   GL_NEAREST_MIPMAP_NEAREST = $2700;
 516   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 517   GL_LINEAR                 = $2601;
 518   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 519   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 520
 521   { Texture Wrap }
 522   GL_TEXTURE_WRAP_S   = $2802;
 523   GL_TEXTURE_WRAP_T   = $2803;
 524   GL_TEXTURE_WRAP_R   = $8072;
 525   GL_CLAMP            = $2900;
 526   GL_REPEAT           = $2901;
 527   GL_CLAMP_TO_EDGE    = $812F;
 528   GL_CLAMP_TO_BORDER  = $812D;
 529   GL_MIRRORED_REPEAT  = $8370;
 530
 531   { Other }
 532   GL_GENERATE_MIPMAP      = $8191;
 533   GL_TEXTURE_BORDER_COLOR = $1004;
 534   GL_MAX_TEXTURE_SIZE     = $0D33;
 535   GL_PACK_ALIGNMENT       = $0D05;
 536   GL_UNPACK_ALIGNMENT     = $0CF5;
 537
 538   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 539   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 540   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;
 541   GL_TEXTURE_GEN_MODE               = $2500;
 542
 543 {$IF DEFINED(GLB_WIN)}
 544   libglu    = 'glu32.dll';
 545   libopengl = 'opengl32.dll';
 546 {$ELSEIF DEFINED(GLB_LINUX)}
 547   libglu    = 'libGLU.so.1';
 548   libopengl = 'libGL.so.1';
 549 {$IFEND}
 550
 551 type
 552   GLboolean = BYTEBOOL;
 553   GLint     = Integer;
 554   GLsizei   = Integer;
 555   GLuint    = Cardinal;
 556   GLfloat   = Single;
 557   GLenum    = Cardinal;
 558
 559   PGLvoid    = Pointer;
 560   PGLboolean = ^GLboolean;
 561   PGLint     = ^GLint;
 562   PGLuint    = ^GLuint;
 563   PGLfloat   = ^GLfloat;
 564
 565   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 566   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}
 567   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 568
 569 {$IF DEFINED(GLB_WIN)}
 570   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 571 {$ELSEIF DEFINED(GLB_LINUX)}
 572   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 573   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 574 {$IFEND}
 575
 576 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 577   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 578   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 579
 580   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 581   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 582
 583   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 584   TglTexParameteriv         = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 585   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 586   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 587   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 588   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 589   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 590
 591   TglTexGeni        = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 592   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 593   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 594   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 595
 596   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 597   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 598   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 599
 600   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}
 601   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}
 602   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 603
 604   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 605   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 606
 607 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 608   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 609   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 610
 611   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 612   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 613
 614   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 615   procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 616   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 617   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 618   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 619   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 620   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 621
 622   procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 623   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 624   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 625   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 626
 627   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 628   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;
 629   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 630
 631   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;
 632   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;
 633   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 634
 635   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 636   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 637 {$IFEND}
 638
 639 var
 640   GL_VERSION_1_2,
 641   GL_VERSION_1_3,
 642   GL_VERSION_1_4,
 643   GL_VERSION_2_0,
 644   GL_VERSION_3_3,
 645
 646   GL_SGIS_generate_mipmap,
 647
 648   GL_ARB_texture_border_clamp,
 649   GL_ARB_texture_mirrored_repeat,
 650   GL_ARB_texture_rectangle,
 651   GL_ARB_texture_non_power_of_two,
 652   GL_ARB_texture_swizzle,
 653   GL_ARB_texture_cube_map,
 654
 655   GL_IBM_texture_mirrored_repeat,
 656
 657   GL_NV_texture_rectangle,
 658
 659   GL_EXT_texture_edge_clamp,
 660   GL_EXT_texture_rectangle,
 661   GL_EXT_texture_swizzle,
 662   GL_EXT_texture_cube_map,
 663   GL_EXT_texture_filter_anisotropic: Boolean;
 664
 665   glCompressedTexImage1D: TglCompressedTexImage1D;
 666   glCompressedTexImage2D: TglCompressedTexImage2D;
 667   glGetCompressedTexImage: TglGetCompressedTexImage;
 668
 669 {$IF DEFINED(GLB_WIN)}
 670   wglGetProcAddress: TwglGetProcAddress;
 671 {$ELSEIF DEFINED(GLB_LINUX)}
 672   glXGetProcAddress: TglXGetProcAddress;
 673   glXGetProcAddressARB: TglXGetProcAddress;
 674 {$IFEND}
 675
 676 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 677   glEnable: TglEnable;
 678   glDisable: TglDisable;
 679
 680   glGetString: TglGetString;
 681   glGetIntegerv: TglGetIntegerv;
 682
 683   glTexParameteri: TglTexParameteri;
 684   glTexParameteriv: TglTexParameteriv;
 685   glTexParameterfv: TglTexParameterfv;
 686   glGetTexParameteriv: TglGetTexParameteriv;
 687   glGetTexParameterfv: TglGetTexParameterfv;
 688   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 689   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 690
 691   glTexGeni: TglTexGeni;
 692   glGenTextures: TglGenTextures;
 693   glBindTexture: TglBindTexture;
 694   glDeleteTextures: TglDeleteTextures;
 695
 696   glAreTexturesResident: TglAreTexturesResident;
 697   glReadPixels: TglReadPixels;
 698   glPixelStorei: TglPixelStorei;
 699
 700   glTexImage1D: TglTexImage1D;
 701   glTexImage2D: TglTexImage2D;
 702   glGetTexImage: TglGetTexImage;
 703
 704   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 705   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 706 {$ENDIF}
 707 {$ENDIF}
 708
 709 type
 710 ////////////////////////////////////////////////////////////////////////////////////////////////////
 711   TglBitmapFormat = (
 712     tfEmpty = 0, //must be smallest value!
 713
 714     tfAlpha4,
 715     tfAlpha8,
 716     tfAlpha12,
 717     tfAlpha16,
 718
 719     tfLuminance4,
 720     tfLuminance8,
 721     tfLuminance12,
 722     tfLuminance16,
 723
 724     tfLuminance4Alpha4,
 725     tfLuminance6Alpha2,
 726     tfLuminance8Alpha8,
 727     tfLuminance12Alpha4,
 728     tfLuminance12Alpha12,
 729     tfLuminance16Alpha16,
 730
 731     tfR3G3B2,
 732     tfRGB4,
 733     tfR5G6B5,
 734     tfRGB5,
 735     tfRGB8,
 736     tfRGB10,
 737     tfRGB12,
 738     tfRGB16,
 739
 740     tfRGBA2,
 741     tfRGBA4,
 742     tfRGB5A1,
 743     tfRGBA8,
 744     tfRGB10A2,
 745     tfRGBA12,
 746     tfRGBA16,
 747
 748     tfBGR4,
 749     tfB5G6R5,
 750     tfBGR5,
 751     tfBGR8,
 752     tfBGR10,
 753     tfBGR12,
 754     tfBGR16,
 755
 756     tfBGRA2,
 757     tfBGRA4,
 758     tfBGR5A1,
 759     tfBGRA8,
 760     tfBGR10A2,
 761     tfBGRA12,
 762     tfBGRA16,
 763
 764     tfDepth16,
 765     tfDepth24,
 766     tfDepth32,
 767
 768     tfS3tcDtx1RGBA,
 769     tfS3tcDtx3RGBA,
 770     tfS3tcDtx5RGBA
 771   );
 772
 773   TglBitmapFileType = (
 774      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 775      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 776      ftDDS,
 777      ftTGA,
 778      ftBMP);
 779    TglBitmapFileTypes = set of TglBitmapFileType;
 780
 781    TglBitmapMipMap = (
 782      mmNone,
 783      mmMipmap,
 784      mmMipmapGlu);
 785
 786    TglBitmapNormalMapFunc = (
 787      nm4Samples,
 788      nmSobel,
 789      nm3x3,
 790      nm5x5);
 791
 792  ////////////////////////////////////////////////////////////////////////////////////////////////////
 793    EglBitmap                  = class(Exception);
 794    EglBitmapNotSupported      = class(Exception);
 795    EglBitmapSizeToLarge       = class(EglBitmap);
 796    EglBitmapNonPowerOfTwo     = class(EglBitmap);
 797    EglBitmapUnsupportedFormat = class(EglBitmap)
 798      constructor Create(const aFormat: TglBitmapFormat); overload;
 799      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 800    end;
 801
 802 ////////////////////////////////////////////////////////////////////////////////////////////////////
 803   TglBitmapColorRec = packed record
 804   case Integer of
 805     0: (r, g, b, a: Cardinal);
 806     1: (arr: array[0..3] of Cardinal);
 807   end;
 808
 809   TglBitmapPixelData = packed record
 810     Data, Range: TglBitmapColorRec;
 811     Format: TglBitmapFormat;
 812   end;
 813   PglBitmapPixelData = ^TglBitmapPixelData;
 814
 815 ////////////////////////////////////////////////////////////////////////////////////////////////////
 816   TglBitmapPixelPositionFields = set of (ffX, ffY);
 817   TglBitmapPixelPosition = record
 818     Fields : TglBitmapPixelPositionFields;
 819     X : Word;
 820     Y : Word;
 821   end;
 822
 823   TglBitmapFormatDescriptor = class(TObject)
 824   protected
 825     function GetIsCompressed: Boolean; virtual; abstract;
 826     function GetHasAlpha:     Boolean; virtual; abstract;
 827
 828     function GetglDataFormat:     GLenum;  virtual; abstract;
 829     function GetglFormat:         GLenum;  virtual; abstract;
 830     function GetglInternalFormat: GLenum;  virtual; abstract;
 831   public
 832     property IsCompressed: Boolean read GetIsCompressed;
 833     property HasAlpha:     Boolean read GetHasAlpha;
 834
 835     property glFormat:         GLenum  read GetglFormat;
 836     property glInternalFormat: GLenum  read GetglInternalFormat;
 837     property glDataFormat:     GLenum  read GetglDataFormat;
 838   end;
 839
 840 ////////////////////////////////////////////////////////////////////////////////////////////////////
 841   TglBitmap = class;
 842   TglBitmapFunctionRec = record
 843     Sender:   TglBitmap;
 844     Size:     TglBitmapPixelPosition;
 845     Position: TglBitmapPixelPosition;
 846     Source:   TglBitmapPixelData;
 847     Dest:     TglBitmapPixelData;
 848     Args:     Pointer;
 849   end;
 850   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 851
 852 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 853   TglBitmap = class
 854   private
 855     function GetFormatDesc: TglBitmapFormatDescriptor;
 856   protected
 857     fID: GLuint;
 858     fTarget: GLuint;
 859     fAnisotropic: Integer;
 860     fDeleteTextureOnFree: Boolean;
 861     fFreeDataAfterGenTexture: Boolean;
 862     fData: PByte;
 863     fIsResident: Boolean;
 864     fBorderColor: array[0..3] of Single;
 865
 866     fDimension: TglBitmapPixelPosition;
 867     fMipMap: TglBitmapMipMap;
 868     fFormat: TglBitmapFormat;
 869
 870     // Mapping
 871     fPixelSize: Integer;
 872     fRowSize: Integer;
 873
 874     // Filtering
 875     fFilterMin: GLenum;
 876     fFilterMag: GLenum;
 877
 878     // TexturWarp
 879     fWrapS: GLenum;
 880     fWrapT: GLenum;
 881     fWrapR: GLenum;
 882
 883     //Swizzle
 884     fSwizzle: array[0..3] of GLenum;
 885
 886     // CustomData
 887     fFilename: String;
 888     fCustomName: String;
 889     fCustomNameW: WideString;
 890     fCustomData: Pointer;
 891
 892     //Getter
 893     function GetWidth:  Integer; virtual;
 894     function GetHeight: Integer; virtual;
 895
 896     function GetFileWidth:  Integer; virtual;
 897     function GetFileHeight: Integer; virtual;
 898
 899     //Setter
 900     procedure SetCustomData(const aValue: Pointer);
 901     procedure SetCustomName(const aValue: String);
 902     procedure SetCustomNameW(const aValue: WideString);
 903     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 904     procedure SetFormat(const aValue: TglBitmapFormat);
 905     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 906     procedure SetID(const aValue: Cardinal);
 907     procedure SetMipMap(const aValue: TglBitmapMipMap);
 908     procedure SetTarget(const aValue: Cardinal);
 909     procedure SetAnisotropic(const aValue: Integer);
 910
 911     procedure CreateID;
 912     procedure SetupParameters(out aBuildWithGlu: Boolean);
 913     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 914       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
 915     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 916
 917     function FlipHorz: Boolean; virtual;
 918     function FlipVert: Boolean; virtual;
 919
 920     property Width:  Integer read GetWidth;
 921     property Height: Integer read GetHeight;
 922
 923     property FileWidth:  Integer read GetFileWidth;
 924     property FileHeight: Integer read GetFileHeight;
 925   public
 926     //Properties
 927     property ID:           Cardinal        read fID          write SetID;
 928     property Target:       Cardinal        read fTarget      write SetTarget;
 929     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 930     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 931     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 932
 933     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
 934
 935     property Filename:    String     read fFilename;
 936     property CustomName:  String     read fCustomName  write SetCustomName;
 937     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
 938     property CustomData:  Pointer    read fCustomData  write SetCustomData;
 939
 940     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
 941     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
 942
 943     property Dimension:  TglBitmapPixelPosition  read fDimension;
 944     property Data:       PByte                   read fData;
 945     property IsResident: Boolean                 read fIsResident;
 946
 947     procedure AfterConstruction; override;
 948     procedure BeforeDestruction; override;
 949
 950     procedure PrepareResType(var aResource: String; var aResType: PChar);
 951
 952     //Load
 953     procedure LoadFromFile(const aFilename: String);
 954     procedure LoadFromStream(const aStream: TStream); virtual;
 955     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
 956       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
 957     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
 958     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 959
 960     //Save
 961     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
 962     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 963
 964     //Convert
 965     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 966     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 967       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 968   public
 969     //Alpha & Co
 970     {$IFDEF GLB_SDL}
 971     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 972     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 973     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 974     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
 975       const aArgs: Pointer = nil): Boolean;
 976     {$ENDIF}
 977
 978     {$IFDEF GLB_DELPHI}
 979     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 980     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 981     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 982     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
 983       const aArgs: Pointer = nil): Boolean;
 984     {$ENDIF}
 985
 986     {$IFDEF GLB_LAZARUS}
 987     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 988     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
 989     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 990     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
 991       const aArgs: Pointer = nil): Boolean;
 992     {$ENDIF}
 993
 994     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
 995       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 996     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
 997       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 998
 999     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1000     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1001     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1002     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1003
1004     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1005     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1006     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1007
1008     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1009     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1010     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1011
1012     function RemoveAlpha: Boolean; virtual;
1013   public
1014     //Common
1015     function Clone: TglBitmap;
1016     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1017     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1018     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1019     procedure FreeData;
1020
1021     //ColorFill
1022     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1023     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1024     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1025
1026     //TexParameters
1027     procedure SetFilter(const aMin, aMag: GLenum);
1028     procedure SetWrap(
1029       const S: GLenum = GL_CLAMP_TO_EDGE;
1030       const T: GLenum = GL_CLAMP_TO_EDGE;
1031       const R: GLenum = GL_CLAMP_TO_EDGE);
1032     procedure SetSwizzle(const r, g, b, a: GLenum);
1033
1034     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1035     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1036
1037     //Constructors
1038     constructor Create; overload;
1039     constructor Create(const aFileName: String); overload;
1040     constructor Create(const aStream: TStream); overload;
1041     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
1042     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1043     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1044     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1045   private
1046     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1047     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1048
1049     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1050     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1051
1052     function LoadBMP(const aStream: TStream): Boolean; virtual;
1053     procedure SaveBMP(const aStream: TStream); virtual;
1054
1055     function LoadTGA(const aStream: TStream): Boolean; virtual;
1056     procedure SaveTGA(const aStream: TStream); virtual;
1057
1058     function LoadDDS(const aStream: TStream): Boolean; virtual;
1059     procedure SaveDDS(const aStream: TStream); virtual;
1060   end;
1061
1062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1063   TglBitmap1D = class(TglBitmap)
1064   protected
1065     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1066       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1067     procedure UploadData(const aBuildWithGlu: Boolean);
1068   public
1069     property Width;
1070     procedure AfterConstruction; override;
1071     function FlipHorz: Boolean; override;
1072     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1073   end;
1074
1075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1076   TglBitmap2D = class(TglBitmap)
1077   protected
1078     fLines: array of PByte;
1079     function GetScanline(const aIndex: Integer): Pointer;
1080     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1081       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1082     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1083   public
1084     property Width;
1085     property Height;
1086     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1087
1088     procedure AfterConstruction; override;
1089
1090     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1091     procedure GetDataFromTexture;
1092     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1093
1094     function FlipHorz: Boolean; override;
1095     function FlipVert: Boolean; override;
1096
1097     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1098       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1099   end;
1100
1101 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1102   TglBitmapCubeMap = class(TglBitmap2D)
1103   protected
1104     fGenMode: Integer;
1105     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1106   public
1107     procedure AfterConstruction; override;
1108     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1109     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1110     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1111   end;
1112
1113 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1114   TglBitmapNormalMap = class(TglBitmapCubeMap)
1115   public
1116     procedure AfterConstruction; override;
1117     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1118   end;
1119
1120 const
1121   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1122
1123 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1124 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1125 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1126 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1127 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1128 procedure glBitmapSetDefaultWrap(
1129   const S: Cardinal = GL_CLAMP_TO_EDGE;
1130   const T: Cardinal = GL_CLAMP_TO_EDGE;
1131   const R: Cardinal = GL_CLAMP_TO_EDGE);
1132
1133 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1134 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1135 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1136 function glBitmapGetDefaultFormat: TglBitmapFormat;
1137 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1138 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1139
1140 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1141 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1142 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1143
1144 var
1145   glBitmapDefaultDeleteTextureOnFree: Boolean;
1146   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1147   glBitmapDefaultFormat: TglBitmapFormat;
1148   glBitmapDefaultMipmap: TglBitmapMipMap;
1149   glBitmapDefaultFilterMin: Cardinal;
1150   glBitmapDefaultFilterMag: Cardinal;
1151   glBitmapDefaultWrapS: Cardinal;
1152   glBitmapDefaultWrapT: Cardinal;
1153   glBitmapDefaultWrapR: Cardinal;
1154   glDefaultSwizzle: array[0..3] of GLenum;
1155
1156 {$IFDEF GLB_DELPHI}
1157 function CreateGrayPalette: HPALETTE;
1158 {$ENDIF}
1159
1160 implementation
1161
1162 uses
1163   Math, syncobjs, typinfo;
1164
1165 type
1166 {$IFNDEF fpc}
1167   QWord   = System.UInt64;
1168   PQWord  = ^QWord;
1169
1170   PtrInt  = Longint;
1171   PtrUInt = DWord;
1172 {$ENDIF}
1173
1174 ////////////////////////////////////////////////////////////////////////////////////////////////////
1175   TShiftRec = packed record
1176   case Integer of
1177     0: (r, g, b, a: Byte);
1178     1: (arr: array[0..3] of Byte);
1179   end;
1180
1181   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1182   private
1183     function GetRedMask: QWord;
1184     function GetGreenMask: QWord;
1185     function GetBlueMask: QWord;
1186     function GetAlphaMask: QWord;
1187   protected
1188     fFormat: TglBitmapFormat;
1189     fWithAlpha: TglBitmapFormat;
1190     fWithoutAlpha: TglBitmapFormat;
1191     fRGBInverted: TglBitmapFormat;
1192     fUncompressed: TglBitmapFormat;
1193     fPixelSize: Single;
1194     fIsCompressed: Boolean;
1195
1196     fRange: TglBitmapColorRec;
1197     fShift: TShiftRec;
1198
1199     fglFormat:         GLenum;
1200     fglInternalFormat: GLenum;
1201     fglDataFormat:     GLenum;
1202
1203     function GetIsCompressed: Boolean; override;
1204     function GetHasAlpha: Boolean; override;
1205
1206     function GetglFormat: GLenum; override;
1207     function GetglInternalFormat: GLenum; override;
1208     function GetglDataFormat: GLenum; override;
1209
1210     function GetComponents: Integer; virtual;
1211   public
1212     property Format:       TglBitmapFormat read fFormat;
1213     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1214     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1215     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1216     property Components:   Integer         read GetComponents;
1217     property PixelSize:    Single          read fPixelSize;
1218
1219     property Range: TglBitmapColorRec read fRange;
1220     property Shift: TShiftRec         read fShift;
1221
1222     property RedMask:   QWord read GetRedMask;
1223     property GreenMask: QWord read GetGreenMask;
1224     property BlueMask:  QWord read GetBlueMask;
1225     property AlphaMask: QWord read GetAlphaMask;
1226
1227     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1228     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1229
1230     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1231     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1232
1233     function CreateMappingData: Pointer; virtual;
1234     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1235
1236     function IsEmpty:  Boolean; virtual;
1237     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1238
1239     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1240
1241     constructor Create; virtual;
1242   public
1243     class procedure Init;
1244     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1245     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1246     class procedure Clear;
1247     class procedure Finalize;
1248   end;
1249   TFormatDescriptorClass = class of TFormatDescriptor;
1250
1251   TfdEmpty = class(TFormatDescriptor);
1252
1253 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1254   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1255     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1256     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1257     constructor Create; override;
1258   end;
1259
1260   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1261     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1262     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1263     constructor Create; override;
1264   end;
1265
1266   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1267     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1268     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1269     constructor Create; override;
1270   end;
1271
1272   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1273     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1274     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1275     constructor Create; override;
1276   end;
1277
1278   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1279     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1280     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1281     constructor Create; override;
1282   end;
1283
1284   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1285     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1286     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1287     constructor Create; override;
1288   end;
1289
1290   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1291     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1292     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1293     constructor Create; override;
1294   end;
1295
1296   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1297     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1298     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1299     constructor Create; override;
1300   end;
1301
1302 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1303   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1304     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1305     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1306     constructor Create; override;
1307   end;
1308
1309   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1310     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1311     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1312     constructor Create; override;
1313   end;
1314
1315   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1316     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1317     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1318     constructor Create; override;
1319   end;
1320
1321   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1322     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1323     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1324     constructor Create; override;
1325   end;
1326
1327   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1328     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1329     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1330     constructor Create; override;
1331   end;
1332
1333   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1334     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1335     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1336     constructor Create; override;
1337   end;
1338
1339   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1340     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1341     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1342     constructor Create; override;
1343   end;
1344
1345   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1346     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1347     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1348     constructor Create; override;
1349   end;
1350
1351   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1352     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1353     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1354     constructor Create; override;
1355   end;
1356
1357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1358   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1359     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1360     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1361     constructor Create; override;
1362   end;
1363
1364   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1365     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1366     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1367     constructor Create; override;
1368   end;
1369
1370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1371   TfdAlpha4 = class(TfdAlpha_UB1)
1372     constructor Create; override;
1373   end;
1374
1375   TfdAlpha8 = class(TfdAlpha_UB1)
1376     constructor Create; override;
1377   end;
1378
1379   TfdAlpha12 = class(TfdAlpha_US1)
1380     constructor Create; override;
1381   end;
1382
1383   TfdAlpha16 = class(TfdAlpha_US1)
1384     constructor Create; override;
1385   end;
1386
1387   TfdLuminance4 = class(TfdLuminance_UB1)
1388     constructor Create; override;
1389   end;
1390
1391   TfdLuminance8 = class(TfdLuminance_UB1)
1392     constructor Create; override;
1393   end;
1394
1395   TfdLuminance12 = class(TfdLuminance_US1)
1396     constructor Create; override;
1397   end;
1398
1399   TfdLuminance16 = class(TfdLuminance_US1)
1400     constructor Create; override;
1401   end;
1402
1403   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1404     constructor Create; override;
1405   end;
1406
1407   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1408     constructor Create; override;
1409   end;
1410
1411   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1412     constructor Create; override;
1413   end;
1414
1415   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1416     constructor Create; override;
1417   end;
1418
1419   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1420     constructor Create; override;
1421   end;
1422
1423   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1424     constructor Create; override;
1425   end;
1426
1427   TfdR3G3B2 = class(TfdUniversal_UB1)
1428     constructor Create; override;
1429   end;
1430
1431   TfdRGB4 = class(TfdUniversal_US1)
1432     constructor Create; override;
1433   end;
1434
1435   TfdR5G6B5 = class(TfdUniversal_US1)
1436     constructor Create; override;
1437   end;
1438
1439   TfdRGB5 = class(TfdUniversal_US1)
1440     constructor Create; override;
1441   end;
1442
1443   TfdRGB8 = class(TfdRGB_UB3)
1444     constructor Create; override;
1445   end;
1446
1447   TfdRGB10 = class(TfdUniversal_UI1)
1448     constructor Create; override;
1449   end;
1450
1451   TfdRGB12 = class(TfdRGB_US3)
1452     constructor Create; override;
1453   end;
1454
1455   TfdRGB16 = class(TfdRGB_US3)
1456     constructor Create; override;
1457   end;
1458
1459   TfdRGBA2 = class(TfdRGBA_UB4)
1460     constructor Create; override;
1461   end;
1462
1463   TfdRGBA4 = class(TfdUniversal_US1)
1464     constructor Create; override;
1465   end;
1466
1467   TfdRGB5A1 = class(TfdUniversal_US1)
1468     constructor Create; override;
1469   end;
1470
1471   TfdRGBA8 = class(TfdRGBA_UB4)
1472     constructor Create; override;
1473   end;
1474
1475   TfdRGB10A2 = class(TfdUniversal_UI1)
1476     constructor Create; override;
1477   end;
1478
1479   TfdRGBA12 = class(TfdRGBA_US4)
1480     constructor Create; override;
1481   end;
1482
1483   TfdRGBA16 = class(TfdRGBA_US4)
1484     constructor Create; override;
1485   end;
1486
1487   TfdBGR4 = class(TfdUniversal_US1)
1488     constructor Create; override;
1489   end;
1490
1491   TfdB5G6R5 = class(TfdUniversal_US1)
1492     constructor Create; override;
1493   end;
1494
1495   TfdBGR5 = class(TfdUniversal_US1)
1496     constructor Create; override;
1497   end;
1498
1499   TfdBGR8 = class(TfdBGR_UB3)
1500     constructor Create; override;
1501   end;
1502
1503   TfdBGR10 = class(TfdUniversal_UI1)
1504     constructor Create; override;
1505   end;
1506
1507   TfdBGR12 = class(TfdBGR_US3)
1508     constructor Create; override;
1509   end;
1510
1511   TfdBGR16 = class(TfdBGR_US3)
1512     constructor Create; override;
1513   end;
1514
1515   TfdBGRA2 = class(TfdBGRA_UB4)
1516     constructor Create; override;
1517   end;
1518
1519   TfdBGRA4 = class(TfdUniversal_US1)
1520     constructor Create; override;
1521   end;
1522
1523   TfdBGR5A1 = class(TfdUniversal_US1)
1524     constructor Create; override;
1525   end;
1526
1527   TfdBGRA8 = class(TfdBGRA_UB4)
1528     constructor Create; override;
1529   end;
1530
1531   TfdBGR10A2 = class(TfdUniversal_UI1)
1532     constructor Create; override;
1533   end;
1534
1535   TfdBGRA12 = class(TfdBGRA_US4)
1536     constructor Create; override;
1537   end;
1538
1539   TfdBGRA16 = class(TfdBGRA_US4)
1540     constructor Create; override;
1541   end;
1542
1543   TfdDepth16 = class(TfdDepth_US1)
1544     constructor Create; override;
1545   end;
1546
1547   TfdDepth24 = class(TfdDepth_UI1)
1548     constructor Create; override;
1549   end;
1550
1551   TfdDepth32 = class(TfdDepth_UI1)
1552     constructor Create; override;
1553   end;
1554
1555   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1556     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1557     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1558     constructor Create; override;
1559   end;
1560
1561   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1562     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1563     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1564     constructor Create; override;
1565   end;
1566
1567   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1568     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1569     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1570     constructor Create; override;
1571   end;
1572
1573 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1574   TbmpBitfieldFormat = class(TFormatDescriptor)
1575   private
1576     procedure SetRedMask  (const aValue: QWord);
1577     procedure SetGreenMask(const aValue: QWord);
1578     procedure SetBlueMask (const aValue: QWord);
1579     procedure SetAlphaMask(const aValue: QWord);
1580
1581     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1582   public
1583     property RedMask:   QWord read GetRedMask   write SetRedMask;
1584     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1585     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1586     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1587
1588     property PixelSize: Single read fPixelSize write fPixelSize;
1589
1590     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1591     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1592   end;
1593
1594 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1595   TbmpColorTableEnty = packed record
1596     b, g, r, a: Byte;
1597   end;
1598   TbmpColorTable = array of TbmpColorTableEnty;
1599   TbmpColorTableFormat = class(TFormatDescriptor)
1600   private
1601     fColorTable: TbmpColorTable;
1602   public
1603     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1604     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1605     property Range:      TglBitmapColorRec read fRange      write fRange;
1606     property Shift:      TShiftRec         read fShift      write fShift;
1607     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1608
1609     procedure CreateColorTable;
1610
1611     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1612     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1613     destructor Destroy; override;
1614   end;
1615
1616 const
1617   LUMINANCE_WEIGHT_R = 0.30;
1618   LUMINANCE_WEIGHT_G = 0.59;
1619   LUMINANCE_WEIGHT_B = 0.11;
1620
1621   ALPHA_WEIGHT_R = 0.30;
1622   ALPHA_WEIGHT_G = 0.59;
1623   ALPHA_WEIGHT_B = 0.11;
1624
1625   DEPTH_WEIGHT_R = 0.333333333;
1626   DEPTH_WEIGHT_G = 0.333333333;
1627   DEPTH_WEIGHT_B = 0.333333333;
1628
1629   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1630
1631   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1632     TfdEmpty,
1633
1634     TfdAlpha4,
1635     TfdAlpha8,
1636     TfdAlpha12,
1637     TfdAlpha16,
1638
1639     TfdLuminance4,
1640     TfdLuminance8,
1641     TfdLuminance12,
1642     TfdLuminance16,
1643
1644     TfdLuminance4Alpha4,
1645     TfdLuminance6Alpha2,
1646     TfdLuminance8Alpha8,
1647     TfdLuminance12Alpha4,
1648     TfdLuminance12Alpha12,
1649     TfdLuminance16Alpha16,
1650
1651     TfdR3G3B2,
1652     TfdRGB4,
1653     TfdR5G6B5,
1654     TfdRGB5,
1655     TfdRGB8,
1656     TfdRGB10,
1657     TfdRGB12,
1658     TfdRGB16,
1659
1660     TfdRGBA2,
1661     TfdRGBA4,
1662     TfdRGB5A1,
1663     TfdRGBA8,
1664     TfdRGB10A2,
1665     TfdRGBA12,
1666     TfdRGBA16,
1667
1668     TfdBGR4,
1669     TfdB5G6R5,
1670     TfdBGR5,
1671     TfdBGR8,
1672     TfdBGR10,
1673     TfdBGR12,
1674     TfdBGR16,
1675
1676     TfdBGRA2,
1677     TfdBGRA4,
1678     TfdBGR5A1,
1679     TfdBGRA8,
1680     TfdBGR10A2,
1681     TfdBGRA12,
1682     TfdBGRA16,
1683
1684     TfdDepth16,
1685     TfdDepth24,
1686     TfdDepth32,
1687
1688     TfdS3tcDtx1RGBA,
1689     TfdS3tcDtx3RGBA,
1690     TfdS3tcDtx5RGBA
1691   );
1692
1693 var
1694   FormatDescriptorCS: TCriticalSection;
1695   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1696
1697 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1698 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1699 begin
1700   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1701 end;
1702
1703 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1704 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1705 begin
1706   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1707 end;
1708
1709 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1710 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1711 begin
1712   result.Fields := [];
1713
1714   if X >= 0 then
1715     result.Fields := result.Fields + [ffX];
1716   if Y >= 0 then
1717     result.Fields := result.Fields + [ffY];
1718
1719   result.X := Max(0, X);
1720   result.Y := Max(0, Y);
1721 end;
1722
1723 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1724 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1725 begin
1726   result.r := r;
1727   result.g := g;
1728   result.b := b;
1729   result.a := a;
1730 end;
1731
1732 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1733 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1734 var
1735   i: Integer;
1736 begin
1737   result := false;
1738   for i := 0 to high(r1.arr) do
1739     if (r1.arr[i] <> r2.arr[i]) then
1740       exit;
1741   result := true;
1742 end;
1743
1744 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1745 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1746 begin
1747   result.r := r;
1748   result.g := g;
1749   result.b := b;
1750   result.a := a;
1751 end;
1752
1753 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1754 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1755 begin
1756   result := [];
1757
1758   if (aFormat in [
1759         //4 bbp
1760         tfLuminance4,
1761
1762         //8bpp
1763         tfR3G3B2, tfLuminance8,
1764
1765         //16bpp
1766         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1767         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1768
1769         //24bpp
1770         tfBGR8, tfRGB8,
1771
1772         //32bpp
1773         tfRGB10, tfRGB10A2, tfRGBA8,
1774         tfBGR10, tfBGR10A2, tfBGRA8]) then
1775     result := result + [ftBMP];
1776
1777   if (aFormat in [
1778         //8 bpp
1779         tfLuminance8, tfAlpha8,
1780
1781         //16 bpp
1782         tfLuminance16, tfLuminance8Alpha8,
1783         tfRGB5, tfRGB5A1, tfRGBA4,
1784         tfBGR5, tfBGR5A1, tfBGRA4,
1785
1786         //24 bpp
1787         tfRGB8, tfBGR8,
1788
1789         //32 bpp
1790         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1791     result := result + [ftTGA];
1792
1793   if (aFormat in [
1794         //8 bpp
1795         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1796         tfR3G3B2, tfRGBA2, tfBGRA2,
1797
1798         //16 bpp
1799         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1800         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1801         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1802
1803         //24 bpp
1804         tfRGB8, tfBGR8,
1805
1806         //32 bbp
1807         tfLuminance16Alpha16,
1808         tfRGBA8, tfRGB10A2,
1809         tfBGRA8, tfBGR10A2,
1810
1811         //compressed
1812         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1813     result := result + [ftDDS];
1814
1815   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1816   if aFormat in [
1817       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1818       tfRGB8, tfRGBA8,
1819       tfBGR8, tfBGRA8] then
1820     result := result + [ftPNG];
1821   {$ENDIF}
1822
1823   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1824   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1825     result := result + [ftJPEG];
1826   {$ENDIF}
1827 end;
1828
1829 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1830 function IsPowerOfTwo(aNumber: Integer): Boolean;
1831 begin
1832   while (aNumber and 1) = 0 do
1833     aNumber := aNumber shr 1;
1834   result := aNumber = 1;
1835 end;
1836
1837 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1838 function GetTopMostBit(aBitSet: QWord): Integer;
1839 begin
1840   result := 0;
1841   while aBitSet > 0 do begin
1842     inc(result);
1843     aBitSet := aBitSet shr 1;
1844   end;
1845 end;
1846
1847 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1848 function CountSetBits(aBitSet: QWord): Integer;
1849 begin
1850   result := 0;
1851   while aBitSet > 0 do begin
1852     if (aBitSet and 1) = 1 then
1853       inc(result);
1854     aBitSet := aBitSet shr 1;
1855   end;
1856 end;
1857
1858 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1859 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1860 begin
1861   result := Trunc(
1862     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1863     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1864     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1865 end;
1866
1867 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1868 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1869 begin
1870   result := Trunc(
1871     DEPTH_WEIGHT_R * aPixel.Data.r +
1872     DEPTH_WEIGHT_G * aPixel.Data.g +
1873     DEPTH_WEIGHT_B * aPixel.Data.b);
1874 end;
1875
1876 {$IFDEF GLB_NATIVE_OGL}
1877 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1878 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1879 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1880 var
1881   GL_LibHandle: Pointer = nil;
1882
1883 function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
1884 begin
1885   if not Assigned(aLibHandle) then
1886     aLibHandle := GL_LibHandle;
1887
1888 {$IF DEFINED(GLB_WIN)}
1889   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1890   if Assigned(result) then
1891     exit;
1892
1893   if Assigned(wglGetProcAddress) then
1894     result := wglGetProcAddress(aProcName);
1895 {$ELSEIF DEFINED(GLB_LINUX)}
1896   if Assigned(glXGetProcAddress) then begin
1897     result := glXGetProcAddress(aProcName);
1898     if Assigned(result) then
1899       exit;
1900   end;
1901
1902   if Assigned(glXGetProcAddressARB) then begin
1903     result := glXGetProcAddressARB(aProcName);
1904     if Assigned(result) then
1905       exit;
1906   end;
1907
1908   result := dlsym(aLibHandle, aProcName);
1909 {$IFEND}
1910   if not Assigned(result) then
1911     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1912 end;
1913
1914 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1915 var
1916   GLU_LibHandle: Pointer = nil;
1917   OpenGLInitialized: Boolean;
1918   InitOpenGLCS: TCriticalSection;
1919
1920 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1921 procedure glbInitOpenGL;
1922
1923   ////////////////////////////////////////////////////////////////////////////////
1924   function glbLoadLibrary(const aName: PChar): Pointer;
1925   begin
1926     {$IF DEFINED(GLB_WIN)}
1927     result := {%H-}Pointer(LoadLibrary(aName));
1928     {$ELSEIF DEFINED(GLB_LINUX)}
1929     result := dlopen(Name, RTLD_LAZY);
1930     {$ELSE}
1931     result := nil;
1932     {$IFEND}
1933   end;
1934
1935   ////////////////////////////////////////////////////////////////////////////////
1936   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
1937   begin
1938     result := false;
1939     if not Assigned(aLibHandle) then
1940       exit;
1941
1942     {$IF DEFINED(GLB_WIN)}
1943     Result := FreeLibrary({%H-}HINST(aLibHandle));
1944     {$ELSEIF DEFINED(GLB_LINUX)}
1945     Result := dlclose(aLibHandle) = 0;
1946     {$IFEND}
1947   end;
1948
1949 begin
1950   if Assigned(GL_LibHandle) then
1951     glbFreeLibrary(GL_LibHandle);
1952
1953   if Assigned(GLU_LibHandle) then
1954     glbFreeLibrary(GLU_LibHandle);
1955
1956   GL_LibHandle := glbLoadLibrary(libopengl);
1957   if not Assigned(GL_LibHandle) then
1958     raise EglBitmap.Create('unable to load library: ' + libopengl);
1959
1960   GLU_LibHandle := glbLoadLibrary(libglu);
1961   if not Assigned(GLU_LibHandle) then
1962     raise EglBitmap.Create('unable to load library: ' + libglu);
1963
1964   try
1965   {$IF DEFINED(GLB_WIN)}
1966     wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
1967   {$ELSEIF DEFINED(GLB_LINUX)}
1968     glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
1969     glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
1970   {$IFEND}
1971
1972     glEnable := glbGetProcAddress('glEnable');
1973     glDisable := glbGetProcAddress('glDisable');
1974     glGetString := glbGetProcAddress('glGetString');
1975     glGetIntegerv := glbGetProcAddress('glGetIntegerv');
1976     glTexParameteri := glbGetProcAddress('glTexParameteri');
1977     glTexParameteriv := glbGetProcAddress('glTexParameteriv');
1978     glTexParameterfv := glbGetProcAddress('glTexParameterfv');
1979     glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
1980     glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
1981     glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
1982     glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
1983     glTexGeni := glbGetProcAddress('glTexGeni');
1984     glGenTextures := glbGetProcAddress('glGenTextures');
1985     glBindTexture := glbGetProcAddress('glBindTexture');
1986     glDeleteTextures := glbGetProcAddress('glDeleteTextures');
1987     glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
1988     glReadPixels := glbGetProcAddress('glReadPixels');
1989     glPixelStorei := glbGetProcAddress('glPixelStorei');
1990     glTexImage1D := glbGetProcAddress('glTexImage1D');
1991     glTexImage2D := glbGetProcAddress('glTexImage2D');
1992     glGetTexImage := glbGetProcAddress('glGetTexImage');
1993
1994     gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
1995     gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
1996   finally
1997     glbFreeLibrary(GL_LibHandle);
1998     glbFreeLibrary(GLU_LibHandle);
1999   end;
2000 end;
2001 {$ENDIF}
2002
2003 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2004 procedure glbReadOpenGLExtensions;
2005 var
2006   Buffer: AnsiString;
2007   MajorVersion, MinorVersion: Integer;
2008
2009   ///////////////////////////////////////////////////////////////////////////////////////////
2010   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2011   var
2012     Separator: Integer;
2013   begin
2014     aMinor := 0;
2015     aMajor := 0;
2016
2017     Separator := Pos(AnsiString('.'), aBuffer);
2018     if (Separator > 1) and (Separator < Length(aBuffer)) and
2019        (aBuffer[Separator - 1] in ['0'..'9']) and
2020        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2021
2022       Dec(Separator);
2023       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2024         Dec(Separator);
2025
2026       Delete(aBuffer, 1, Separator);
2027       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2028
2029       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2030         Inc(Separator);
2031
2032       Delete(aBuffer, Separator, 255);
2033       Separator := Pos(AnsiString('.'), aBuffer);
2034
2035       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2036       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2037     end;
2038   end;
2039
2040   ///////////////////////////////////////////////////////////////////////////////////////////
2041   function CheckExtension(const Extension: AnsiString): Boolean;
2042   var
2043     ExtPos: Integer;
2044   begin
2045     ExtPos := Pos(Extension, Buffer);
2046     result := ExtPos > 0;
2047     if result then
2048       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2049   end;
2050
2051   ///////////////////////////////////////////////////////////////////////////////////////////
2052   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2053   begin
2054     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2055   end;
2056
2057 begin
2058 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2059   InitOpenGLCS.Enter;
2060   try
2061     if not OpenGLInitialized then begin
2062       glbInitOpenGL;
2063       OpenGLInitialized := true;
2064     end;
2065   finally
2066     InitOpenGLCS.Leave;
2067   end;
2068 {$ENDIF}
2069
2070   // Version
2071   Buffer := glGetString(GL_VERSION);
2072   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2073
2074   GL_VERSION_1_2 := CheckVersion(1, 2);
2075   GL_VERSION_1_3 := CheckVersion(1, 3);
2076   GL_VERSION_1_4 := CheckVersion(1, 4);
2077   GL_VERSION_2_0 := CheckVersion(2, 0);
2078   GL_VERSION_3_3 := CheckVersion(3, 3);
2079
2080   // Extensions
2081   Buffer := glGetString(GL_EXTENSIONS);
2082   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2083   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2084   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2085   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2086   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2087   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2088   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2089   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2090   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2091   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2092   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2093   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2094   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2095   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2096
2097   if GL_VERSION_1_3 then begin
2098     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2099     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2100     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2101   end else begin
2102     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB');
2103     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB');
2104     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
2105   end;
2106 end;
2107 {$ENDIF}
2108
2109 {$IFDEF GLB_SDL_IMAGE}
2110 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2111 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2112 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2113 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2114 begin
2115   result := TStream(context^.unknown.data1).Seek(offset, whence);
2116 end;
2117
2118 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2119 begin
2120   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2121 end;
2122
2123 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2124 begin
2125   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2126 end;
2127
2128 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2129 begin
2130   result := 0;
2131 end;
2132
2133 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2134 begin
2135   result := SDL_AllocRW;
2136
2137   if result = nil then
2138     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2139
2140   result^.seek := glBitmapRWseek;
2141   result^.read := glBitmapRWread;
2142   result^.write := glBitmapRWwrite;
2143   result^.close := glBitmapRWclose;
2144   result^.unknown.data1 := Stream;
2145 end;
2146 {$ENDIF}
2147
2148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2149 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2150 begin
2151   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2152 end;
2153
2154 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2155 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2156 begin
2157   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2158 end;
2159
2160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2161 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2162 begin
2163   glBitmapDefaultMipmap := aValue;
2164 end;
2165
2166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2167 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2168 begin
2169   glBitmapDefaultFormat := aFormat;
2170 end;
2171
2172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2173 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2174 begin
2175   glBitmapDefaultFilterMin := aMin;
2176   glBitmapDefaultFilterMag := aMag;
2177 end;
2178
2179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2180 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2181 begin
2182   glBitmapDefaultWrapS := S;
2183   glBitmapDefaultWrapT := T;
2184   glBitmapDefaultWrapR := R;
2185 end;
2186
2187 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2188 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2189 begin
2190   glDefaultSwizzle[0] := r;
2191   glDefaultSwizzle[1] := g;
2192   glDefaultSwizzle[2] := b;
2193   glDefaultSwizzle[3] := a;
2194 end;
2195
2196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2197 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2198 begin
2199   result := glBitmapDefaultDeleteTextureOnFree;
2200 end;
2201
2202 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2203 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2204 begin
2205   result := glBitmapDefaultFreeDataAfterGenTextures;
2206 end;
2207
2208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2209 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2210 begin
2211   result := glBitmapDefaultMipmap;
2212 end;
2213
2214 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2215 function glBitmapGetDefaultFormat: TglBitmapFormat;
2216 begin
2217   result := glBitmapDefaultFormat;
2218 end;
2219
2220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2221 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2222 begin
2223   aMin := glBitmapDefaultFilterMin;
2224   aMag := glBitmapDefaultFilterMag;
2225 end;
2226
2227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2228 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2229 begin
2230   S := glBitmapDefaultWrapS;
2231   T := glBitmapDefaultWrapT;
2232   R := glBitmapDefaultWrapR;
2233 end;
2234
2235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2236 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2237 begin
2238   r := glDefaultSwizzle[0];
2239   g := glDefaultSwizzle[1];
2240   b := glDefaultSwizzle[2];
2241   a := glDefaultSwizzle[3];
2242 end;
2243
2244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2245 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2247 function TFormatDescriptor.GetRedMask: QWord;
2248 begin
2249   result := fRange.r shl fShift.r;
2250 end;
2251
2252 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2253 function TFormatDescriptor.GetGreenMask: QWord;
2254 begin
2255   result := fRange.g shl fShift.g;
2256 end;
2257
2258 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2259 function TFormatDescriptor.GetBlueMask: QWord;
2260 begin
2261   result := fRange.b shl fShift.b;
2262 end;
2263
2264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2265 function TFormatDescriptor.GetAlphaMask: QWord;
2266 begin
2267   result := fRange.a shl fShift.a;
2268 end;
2269
2270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2271 function TFormatDescriptor.GetIsCompressed: Boolean;
2272 begin
2273   result := fIsCompressed;
2274 end;
2275
2276 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2277 function TFormatDescriptor.GetHasAlpha: Boolean;
2278 begin
2279   result := (fRange.a > 0);
2280 end;
2281
2282 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2283 function TFormatDescriptor.GetglFormat: GLenum;
2284 begin
2285   result := fglFormat;
2286 end;
2287
2288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2289 function TFormatDescriptor.GetglInternalFormat: GLenum;
2290 begin
2291   result := fglInternalFormat;
2292 end;
2293
2294 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2295 function TFormatDescriptor.GetglDataFormat: GLenum;
2296 begin
2297   result := fglDataFormat;
2298 end;
2299
2300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2301 function TFormatDescriptor.GetComponents: Integer;
2302 var
2303   i: Integer;
2304 begin
2305   result := 0;
2306   for i := 0 to 3 do
2307     if (fRange.arr[i] > 0) then
2308       inc(result);
2309 end;
2310
2311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2312 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2313 var
2314   w, h: Integer;
2315 begin
2316   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2317     w := Max(1, aSize.X);
2318     h := Max(1, aSize.Y);
2319     result := GetSize(w, h);
2320   end else
2321     result := 0;
2322 end;
2323
2324 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2325 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2326 begin
2327   result := 0;
2328   if (aWidth <= 0) or (aHeight <= 0) then
2329     exit;
2330   result := Ceil(aWidth * aHeight * fPixelSize);
2331 end;
2332
2333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2334 function TFormatDescriptor.CreateMappingData: Pointer;
2335 begin
2336   result := nil;
2337 end;
2338
2339 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2340 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2341 begin
2342   //DUMMY
2343 end;
2344
2345 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2346 function TFormatDescriptor.IsEmpty: Boolean;
2347 begin
2348   result := (fFormat = tfEmpty);
2349 end;
2350
2351 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2352 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2353 begin
2354   result := false;
2355   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2356     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2357   if (aRedMask   <> RedMask) then
2358     exit;
2359   if (aGreenMask <> GreenMask) then
2360     exit;
2361   if (aBlueMask  <> BlueMask) then
2362     exit;
2363   if (aAlphaMask <> AlphaMask) then
2364     exit;
2365   result := true;
2366 end;
2367
2368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2369 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2370 begin
2371   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2372   aPixel.Data   := fRange;
2373   aPixel.Range  := fRange;
2374   aPixel.Format := fFormat;
2375 end;
2376
2377 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2378 constructor TFormatDescriptor.Create;
2379 begin
2380   inherited Create;
2381
2382   fFormat       := tfEmpty;
2383   fWithAlpha    := tfEmpty;
2384   fWithoutAlpha := tfEmpty;
2385   fRGBInverted  := tfEmpty;
2386   fUncompressed := tfEmpty;
2387   fPixelSize    := 0.0;
2388   fIsCompressed := false;
2389
2390   fglFormat         := 0;
2391   fglInternalFormat := 0;
2392   fglDataFormat     := 0;
2393
2394   FillChar(fRange, 0, SizeOf(fRange));
2395   FillChar(fShift, 0, SizeOf(fShift));
2396 end;
2397
2398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2399 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2401 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2402 begin
2403   aData^ := aPixel.Data.a;
2404   inc(aData);
2405 end;
2406
2407 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2408 begin
2409   aPixel.Data.r := 0;
2410   aPixel.Data.g := 0;
2411   aPixel.Data.b := 0;
2412   aPixel.Data.a := aData^;
2413   inc(aData);
2414 end;
2415
2416 constructor TfdAlpha_UB1.Create;
2417 begin
2418   inherited Create;
2419   fPixelSize        := 1.0;
2420   fRange.a          := $FF;
2421   fglFormat         := GL_ALPHA;
2422   fglDataFormat     := GL_UNSIGNED_BYTE;
2423 end;
2424
2425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2426 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2428 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2429 begin
2430   aData^ := LuminanceWeight(aPixel);
2431   inc(aData);
2432 end;
2433
2434 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2435 begin
2436   aPixel.Data.r := aData^;
2437   aPixel.Data.g := aData^;
2438   aPixel.Data.b := aData^;
2439   aPixel.Data.a := 0;
2440   inc(aData);
2441 end;
2442
2443 constructor TfdLuminance_UB1.Create;
2444 begin
2445   inherited Create;
2446   fPixelSize        := 1.0;
2447   fRange.r          := $FF;
2448   fRange.g          := $FF;
2449   fRange.b          := $FF;
2450   fglFormat         := GL_LUMINANCE;
2451   fglDataFormat     := GL_UNSIGNED_BYTE;
2452 end;
2453
2454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2455 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2456 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2457 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2458 var
2459   i: Integer;
2460 begin
2461   aData^ := 0;
2462   for i := 0 to 3 do
2463     if (fRange.arr[i] > 0) then
2464       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2465   inc(aData);
2466 end;
2467
2468 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2469 var
2470   i: Integer;
2471 begin
2472   for i := 0 to 3 do
2473     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2474   inc(aData);
2475 end;
2476
2477 constructor TfdUniversal_UB1.Create;
2478 begin
2479   inherited Create;
2480   fPixelSize := 1.0;
2481 end;
2482
2483 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2484 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2485 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2486 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2487 begin
2488   inherited Map(aPixel, aData, aMapData);
2489   aData^ := aPixel.Data.a;
2490   inc(aData);
2491 end;
2492
2493 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2494 begin
2495   inherited Unmap(aData, aPixel, aMapData);
2496   aPixel.Data.a := aData^;
2497   inc(aData);
2498 end;
2499
2500 constructor TfdLuminanceAlpha_UB2.Create;
2501 begin
2502   inherited Create;
2503   fPixelSize        := 2.0;
2504   fRange.a          := $FF;
2505   fShift.a          :=   8;
2506   fglFormat         := GL_LUMINANCE_ALPHA;
2507   fglDataFormat     := GL_UNSIGNED_BYTE;
2508 end;
2509
2510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2511 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2513 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2514 begin
2515   aData^ := aPixel.Data.r;
2516   inc(aData);
2517   aData^ := aPixel.Data.g;
2518   inc(aData);
2519   aData^ := aPixel.Data.b;
2520   inc(aData);
2521 end;
2522
2523 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2524 begin
2525   aPixel.Data.r := aData^;
2526   inc(aData);
2527   aPixel.Data.g := aData^;
2528   inc(aData);
2529   aPixel.Data.b := aData^;
2530   inc(aData);
2531   aPixel.Data.a := 0;
2532 end;
2533
2534 constructor TfdRGB_UB3.Create;
2535 begin
2536   inherited Create;
2537   fPixelSize        := 3.0;
2538   fRange.r          := $FF;
2539   fRange.g          := $FF;
2540   fRange.b          := $FF;
2541   fShift.r          :=   0;
2542   fShift.g          :=   8;
2543   fShift.b          :=  16;
2544   fglFormat         := GL_RGB;
2545   fglDataFormat     := GL_UNSIGNED_BYTE;
2546 end;
2547
2548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2549 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2550 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2551 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2552 begin
2553   aData^ := aPixel.Data.b;
2554   inc(aData);
2555   aData^ := aPixel.Data.g;
2556   inc(aData);
2557   aData^ := aPixel.Data.r;
2558   inc(aData);
2559 end;
2560
2561 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2562 begin
2563   aPixel.Data.b := aData^;
2564   inc(aData);
2565   aPixel.Data.g := aData^;
2566   inc(aData);
2567   aPixel.Data.r := aData^;
2568   inc(aData);
2569   aPixel.Data.a := 0;
2570 end;
2571
2572 constructor TfdBGR_UB3.Create;
2573 begin
2574   fPixelSize        := 3.0;
2575   fRange.r          := $FF;
2576   fRange.g          := $FF;
2577   fRange.b          := $FF;
2578   fShift.r          :=  16;
2579   fShift.g          :=   8;
2580   fShift.b          :=   0;
2581   fglFormat         := GL_BGR;
2582   fglDataFormat     := GL_UNSIGNED_BYTE;
2583 end;
2584
2585 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2586 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2587 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2588 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2589 begin
2590   inherited Map(aPixel, aData, aMapData);
2591   aData^ := aPixel.Data.a;
2592   inc(aData);
2593 end;
2594
2595 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2596 begin
2597   inherited Unmap(aData, aPixel, aMapData);
2598   aPixel.Data.a := aData^;
2599   inc(aData);
2600 end;
2601
2602 constructor TfdRGBA_UB4.Create;
2603 begin
2604   inherited Create;
2605   fPixelSize        := 4.0;
2606   fRange.a          := $FF;
2607   fShift.a          :=  24;
2608   fglFormat         := GL_RGBA;
2609   fglDataFormat     := GL_UNSIGNED_BYTE;
2610 end;
2611
2612 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2613 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2614 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2615 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2616 begin
2617   inherited Map(aPixel, aData, aMapData);
2618   aData^ := aPixel.Data.a;
2619   inc(aData);
2620 end;
2621
2622 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2623 begin
2624   inherited Unmap(aData, aPixel, aMapData);
2625   aPixel.Data.a := aData^;
2626   inc(aData);
2627 end;
2628
2629 constructor TfdBGRA_UB4.Create;
2630 begin
2631   inherited Create;
2632   fPixelSize        := 4.0;
2633   fRange.a          := $FF;
2634   fShift.a          :=  24;
2635   fglFormat         := GL_BGRA;
2636   fglDataFormat     := GL_UNSIGNED_BYTE;
2637 end;
2638
2639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2640 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2641 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2642 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2643 begin
2644   PWord(aData)^ := aPixel.Data.a;
2645   inc(aData, 2);
2646 end;
2647
2648 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2649 begin
2650   aPixel.Data.r := 0;
2651   aPixel.Data.g := 0;
2652   aPixel.Data.b := 0;
2653   aPixel.Data.a := PWord(aData)^;
2654   inc(aData, 2);
2655 end;
2656
2657 constructor TfdAlpha_US1.Create;
2658 begin
2659   inherited Create;
2660   fPixelSize        := 2.0;
2661   fRange.a          := $FFFF;
2662   fglFormat         := GL_ALPHA;
2663   fglDataFormat     := GL_UNSIGNED_SHORT;
2664 end;
2665
2666 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2667 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2669 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2670 begin
2671   PWord(aData)^ := LuminanceWeight(aPixel);
2672   inc(aData, 2);
2673 end;
2674
2675 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2676 begin
2677   aPixel.Data.r := PWord(aData)^;
2678   aPixel.Data.g := PWord(aData)^;
2679   aPixel.Data.b := PWord(aData)^;
2680   aPixel.Data.a := 0;
2681   inc(aData, 2);
2682 end;
2683
2684 constructor TfdLuminance_US1.Create;
2685 begin
2686   inherited Create;
2687   fPixelSize        := 2.0;
2688   fRange.r          := $FFFF;
2689   fRange.g          := $FFFF;
2690   fRange.b          := $FFFF;
2691   fglFormat         := GL_LUMINANCE;
2692   fglDataFormat     := GL_UNSIGNED_SHORT;
2693 end;
2694
2695 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2696 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2697 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2698 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2699 var
2700   i: Integer;
2701 begin
2702   PWord(aData)^ := 0;
2703   for i := 0 to 3 do
2704     if (fRange.arr[i] > 0) then
2705       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2706   inc(aData, 2);
2707 end;
2708
2709 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2710 var
2711   i: Integer;
2712 begin
2713   for i := 0 to 3 do
2714     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2715   inc(aData, 2);
2716 end;
2717
2718 constructor TfdUniversal_US1.Create;
2719 begin
2720   inherited Create;
2721   fPixelSize := 2.0;
2722 end;
2723
2724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2725 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2727 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2728 begin
2729   PWord(aData)^ := DepthWeight(aPixel);
2730   inc(aData, 2);
2731 end;
2732
2733 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2734 begin
2735   aPixel.Data.r := PWord(aData)^;
2736   aPixel.Data.g := PWord(aData)^;
2737   aPixel.Data.b := PWord(aData)^;
2738   aPixel.Data.a := 0;
2739   inc(aData, 2);
2740 end;
2741
2742 constructor TfdDepth_US1.Create;
2743 begin
2744   inherited Create;
2745   fPixelSize        := 2.0;
2746   fRange.r          := $FFFF;
2747   fRange.g          := $FFFF;
2748   fRange.b          := $FFFF;
2749   fglFormat         := GL_DEPTH_COMPONENT;
2750   fglDataFormat     := GL_UNSIGNED_SHORT;
2751 end;
2752
2753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2754 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2755 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2756 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2757 begin
2758   inherited Map(aPixel, aData, aMapData);
2759   PWord(aData)^ := aPixel.Data.a;
2760   inc(aData, 2);
2761 end;
2762
2763 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2764 begin
2765   inherited Unmap(aData, aPixel, aMapData);
2766   aPixel.Data.a := PWord(aData)^;
2767   inc(aData, 2);
2768 end;
2769
2770 constructor TfdLuminanceAlpha_US2.Create;
2771 begin
2772   inherited Create;
2773   fPixelSize        :=   4.0;
2774   fRange.a          := $FFFF;
2775   fShift.a          :=    16;
2776   fglFormat         := GL_LUMINANCE_ALPHA;
2777   fglDataFormat     := GL_UNSIGNED_SHORT;
2778 end;
2779
2780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2781 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2782 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2783 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2784 begin
2785   PWord(aData)^ := aPixel.Data.r;
2786   inc(aData, 2);
2787   PWord(aData)^ := aPixel.Data.g;
2788   inc(aData, 2);
2789   PWord(aData)^ := aPixel.Data.b;
2790   inc(aData, 2);
2791 end;
2792
2793 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2794 begin
2795   aPixel.Data.r := PWord(aData)^;
2796   inc(aData, 2);
2797   aPixel.Data.g := PWord(aData)^;
2798   inc(aData, 2);
2799   aPixel.Data.b := PWord(aData)^;
2800   inc(aData, 2);
2801   aPixel.Data.a := 0;
2802 end;
2803
2804 constructor TfdRGB_US3.Create;
2805 begin
2806   inherited Create;
2807   fPixelSize        :=   6.0;
2808   fRange.r          := $FFFF;
2809   fRange.g          := $FFFF;
2810   fRange.b          := $FFFF;
2811   fShift.r          :=     0;
2812   fShift.g          :=    16;
2813   fShift.b          :=    32;
2814   fglFormat         := GL_RGB;
2815   fglDataFormat     := GL_UNSIGNED_SHORT;
2816 end;
2817
2818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2819 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2820 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2821 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2822 begin
2823   PWord(aData)^ := aPixel.Data.b;
2824   inc(aData, 2);
2825   PWord(aData)^ := aPixel.Data.g;
2826   inc(aData, 2);
2827   PWord(aData)^ := aPixel.Data.r;
2828   inc(aData, 2);
2829 end;
2830
2831 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2832 begin
2833   aPixel.Data.b := PWord(aData)^;
2834   inc(aData, 2);
2835   aPixel.Data.g := PWord(aData)^;
2836   inc(aData, 2);
2837   aPixel.Data.r := PWord(aData)^;
2838   inc(aData, 2);
2839   aPixel.Data.a := 0;
2840 end;
2841
2842 constructor TfdBGR_US3.Create;
2843 begin
2844   inherited Create;
2845   fPixelSize        :=   6.0;
2846   fRange.r          := $FFFF;
2847   fRange.g          := $FFFF;
2848   fRange.b          := $FFFF;
2849   fShift.r          :=    32;
2850   fShift.g          :=    16;
2851   fShift.b          :=     0;
2852   fglFormat         := GL_BGR;
2853   fglDataFormat     := GL_UNSIGNED_SHORT;
2854 end;
2855
2856 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2857 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2858 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2859 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2860 begin
2861   inherited Map(aPixel, aData, aMapData);
2862   PWord(aData)^ := aPixel.Data.a;
2863   inc(aData, 2);
2864 end;
2865
2866 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2867 begin
2868   inherited Unmap(aData, aPixel, aMapData);
2869   aPixel.Data.a := PWord(aData)^;
2870   inc(aData, 2);
2871 end;
2872
2873 constructor TfdRGBA_US4.Create;
2874 begin
2875   inherited Create;
2876   fPixelSize        :=   8.0;
2877   fRange.a          := $FFFF;
2878   fShift.a          :=    48;
2879   fglFormat         := GL_RGBA;
2880   fglDataFormat     := GL_UNSIGNED_SHORT;
2881 end;
2882
2883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2884 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2885 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2886 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2887 begin
2888   inherited Map(aPixel, aData, aMapData);
2889   PWord(aData)^ := aPixel.Data.a;
2890   inc(aData, 2);
2891 end;
2892
2893 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2894 begin
2895   inherited Unmap(aData, aPixel, aMapData);
2896   aPixel.Data.a := PWord(aData)^;
2897   inc(aData, 2);
2898 end;
2899
2900 constructor TfdBGRA_US4.Create;
2901 begin
2902   inherited Create;
2903   fPixelSize        :=   8.0;
2904   fRange.a          := $FFFF;
2905   fShift.a          :=    48;
2906   fglFormat         := GL_BGRA;
2907   fglDataFormat     := GL_UNSIGNED_SHORT;
2908 end;
2909
2910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2911 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2913 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2914 var
2915   i: Integer;
2916 begin
2917   PCardinal(aData)^ := 0;
2918   for i := 0 to 3 do
2919     if (fRange.arr[i] > 0) then
2920       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2921   inc(aData, 4);
2922 end;
2923
2924 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2925 var
2926   i: Integer;
2927 begin
2928   for i := 0 to 3 do
2929     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2930   inc(aData, 2);
2931 end;
2932
2933 constructor TfdUniversal_UI1.Create;
2934 begin
2935   inherited Create;
2936   fPixelSize := 4.0;
2937 end;
2938
2939 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2940 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2941 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2942 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2943 begin
2944   PCardinal(aData)^ := DepthWeight(aPixel);
2945   inc(aData, 4);
2946 end;
2947
2948 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2949 begin
2950   aPixel.Data.r := PCardinal(aData)^;
2951   aPixel.Data.g := PCardinal(aData)^;
2952   aPixel.Data.b := PCardinal(aData)^;
2953   aPixel.Data.a := 0;
2954   inc(aData, 4);
2955 end;
2956
2957 constructor TfdDepth_UI1.Create;
2958 begin
2959   inherited Create;
2960   fPixelSize        := 4.0;
2961   fRange.r          := $FFFFFFFF;
2962   fRange.g          := $FFFFFFFF;
2963   fRange.b          := $FFFFFFFF;
2964   fglFormat         := GL_DEPTH_COMPONENT;
2965   fglDataFormat     := GL_UNSIGNED_INT;
2966 end;
2967
2968 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2969 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2970 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2971 constructor TfdAlpha4.Create;
2972 begin
2973   inherited Create;
2974   fFormat           := tfAlpha4;
2975   fWithAlpha        := tfAlpha4;
2976   fglInternalFormat := GL_ALPHA4;
2977 end;
2978
2979 constructor TfdAlpha8.Create;
2980 begin
2981   inherited Create;
2982   fFormat           := tfAlpha8;
2983   fWithAlpha        := tfAlpha8;
2984   fglInternalFormat := GL_ALPHA8;
2985 end;
2986
2987 constructor TfdAlpha12.Create;
2988 begin
2989   inherited Create;
2990   fFormat           := tfAlpha12;
2991   fWithAlpha        := tfAlpha12;
2992   fglInternalFormat := GL_ALPHA12;
2993 end;
2994
2995 constructor TfdAlpha16.Create;
2996 begin
2997   inherited Create;
2998   fFormat           := tfAlpha16;
2999   fWithAlpha        := tfAlpha16;
3000   fglInternalFormat := GL_ALPHA16;
3001 end;
3002
3003 constructor TfdLuminance4.Create;
3004 begin
3005   inherited Create;
3006   fFormat           := tfLuminance4;
3007   fWithAlpha        := tfLuminance4Alpha4;
3008   fWithoutAlpha     := tfLuminance4;
3009   fglInternalFormat := GL_LUMINANCE4;
3010 end;
3011
3012 constructor TfdLuminance8.Create;
3013 begin
3014   inherited Create;
3015   fFormat           := tfLuminance8;
3016   fWithAlpha        := tfLuminance8Alpha8;
3017   fWithoutAlpha     := tfLuminance8;
3018   fglInternalFormat := GL_LUMINANCE8;
3019 end;
3020
3021 constructor TfdLuminance12.Create;
3022 begin
3023   inherited Create;
3024   fFormat           := tfLuminance12;
3025   fWithAlpha        := tfLuminance12Alpha12;
3026   fWithoutAlpha     := tfLuminance12;
3027   fglInternalFormat := GL_LUMINANCE12;
3028 end;
3029
3030 constructor TfdLuminance16.Create;
3031 begin
3032   inherited Create;
3033   fFormat           := tfLuminance16;
3034   fWithAlpha        := tfLuminance16Alpha16;
3035   fWithoutAlpha     := tfLuminance16;
3036   fglInternalFormat := GL_LUMINANCE16;
3037 end;
3038
3039 constructor TfdLuminance4Alpha4.Create;
3040 begin
3041   inherited Create;
3042   fFormat           := tfLuminance4Alpha4;
3043   fWithAlpha        := tfLuminance4Alpha4;
3044   fWithoutAlpha     := tfLuminance4;
3045   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3046 end;
3047
3048 constructor TfdLuminance6Alpha2.Create;
3049 begin
3050   inherited Create;
3051   fFormat           := tfLuminance6Alpha2;
3052   fWithAlpha        := tfLuminance6Alpha2;
3053   fWithoutAlpha     := tfLuminance8;
3054   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3055 end;
3056
3057 constructor TfdLuminance8Alpha8.Create;
3058 begin
3059   inherited Create;
3060   fFormat           := tfLuminance8Alpha8;
3061   fWithAlpha        := tfLuminance8Alpha8;
3062   fWithoutAlpha     := tfLuminance8;
3063   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3064 end;
3065
3066 constructor TfdLuminance12Alpha4.Create;
3067 begin
3068   inherited Create;
3069   fFormat           := tfLuminance12Alpha4;
3070   fWithAlpha        := tfLuminance12Alpha4;
3071   fWithoutAlpha     := tfLuminance12;
3072   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3073 end;
3074
3075 constructor TfdLuminance12Alpha12.Create;
3076 begin
3077   inherited Create;
3078   fFormat           := tfLuminance12Alpha12;
3079   fWithAlpha        := tfLuminance12Alpha12;
3080   fWithoutAlpha     := tfLuminance12;
3081   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3082 end;
3083
3084 constructor TfdLuminance16Alpha16.Create;
3085 begin
3086   inherited Create;
3087   fFormat           := tfLuminance16Alpha16;
3088   fWithAlpha        := tfLuminance16Alpha16;
3089   fWithoutAlpha     := tfLuminance16;
3090   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3091 end;
3092
3093 constructor TfdR3G3B2.Create;
3094 begin
3095   inherited Create;
3096   fFormat           := tfR3G3B2;
3097   fWithAlpha        := tfRGBA2;
3098   fWithoutAlpha     := tfR3G3B2;
3099   fRange.r          := $7;
3100   fRange.g          := $7;
3101   fRange.b          := $3;
3102   fShift.r          :=  0;
3103   fShift.g          :=  3;
3104   fShift.b          :=  6;
3105   fglFormat         := GL_RGB;
3106   fglInternalFormat := GL_R3_G3_B2;
3107   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3108 end;
3109
3110 constructor TfdRGB4.Create;
3111 begin
3112   inherited Create;
3113   fFormat           := tfRGB4;
3114   fWithAlpha        := tfRGBA4;
3115   fWithoutAlpha     := tfRGB4;
3116   fRGBInverted      := tfBGR4;
3117   fRange.r          := $F;
3118   fRange.g          := $F;
3119   fRange.b          := $F;
3120   fShift.r          :=  0;
3121   fShift.g          :=  4;
3122   fShift.b          :=  8;
3123   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3124   fglInternalFormat := GL_RGB4;
3125   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3126 end;
3127
3128 constructor TfdR5G6B5.Create;
3129 begin
3130   inherited Create;
3131   fFormat           := tfR5G6B5;
3132   fWithAlpha        := tfRGBA4;
3133   fWithoutAlpha     := tfR5G6B5;
3134   fRGBInverted      := tfB5G6R5;
3135   fRange.r          := $1F;
3136   fRange.g          := $3F;
3137   fRange.b          := $1F;
3138   fShift.r          :=   0;
3139   fShift.g          :=   5;
3140   fShift.b          :=  11;
3141   fglFormat         := GL_RGB;
3142   fglInternalFormat := GL_RGB565;
3143   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3144 end;
3145
3146 constructor TfdRGB5.Create;
3147 begin
3148   inherited Create;
3149   fFormat           := tfRGB5;
3150   fWithAlpha        := tfRGB5A1;
3151   fWithoutAlpha     := tfRGB5;
3152   fRGBInverted      := tfBGR5;
3153   fRange.r          := $1F;
3154   fRange.g          := $1F;
3155   fRange.b          := $1F;
3156   fShift.r          :=   0;
3157   fShift.g          :=   5;
3158   fShift.b          :=  10;
3159   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3160   fglInternalFormat := GL_RGB5;
3161   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3162 end;
3163
3164 constructor TfdRGB8.Create;
3165 begin
3166   inherited Create;
3167   fFormat           := tfRGB8;
3168   fWithAlpha        := tfRGBA8;
3169   fWithoutAlpha     := tfRGB8;
3170   fRGBInverted      := tfBGR8;
3171   fglInternalFormat := GL_RGB8;
3172 end;
3173
3174 constructor TfdRGB10.Create;
3175 begin
3176   inherited Create;
3177   fFormat           := tfRGB10;
3178   fWithAlpha        := tfRGB10A2;
3179   fWithoutAlpha     := tfRGB10;
3180   fRGBInverted      := tfBGR10;
3181   fRange.r          := $3FF;
3182   fRange.g          := $3FF;
3183   fRange.b          := $3FF;
3184   fShift.r          :=    0;
3185   fShift.g          :=   10;
3186   fShift.b          :=   20;
3187   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3188   fglInternalFormat := GL_RGB10;
3189   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3190 end;
3191
3192 constructor TfdRGB12.Create;
3193 begin
3194   inherited Create;
3195   fFormat           := tfRGB12;
3196   fWithAlpha        := tfRGBA12;
3197   fWithoutAlpha     := tfRGB12;
3198   fRGBInverted      := tfBGR12;
3199   fglInternalFormat := GL_RGB12;
3200 end;
3201
3202 constructor TfdRGB16.Create;
3203 begin
3204   inherited Create;
3205   fFormat           := tfRGB16;
3206   fWithAlpha        := tfRGBA16;
3207   fWithoutAlpha     := tfRGB16;
3208   fRGBInverted      := tfBGR16;
3209   fglInternalFormat := GL_RGB16;
3210 end;
3211
3212 constructor TfdRGBA2.Create;
3213 begin
3214   inherited Create;
3215   fFormat           := tfRGBA2;
3216   fWithAlpha        := tfRGBA2;
3217   fWithoutAlpha     := tfR3G3B2;
3218   fRGBInverted      := tfBGRA2;
3219   fglInternalFormat := GL_RGBA2;
3220 end;
3221
3222 constructor TfdRGBA4.Create;
3223 begin
3224   inherited Create;
3225   fFormat           := tfRGBA4;
3226   fWithAlpha        := tfRGBA4;
3227   fWithoutAlpha     := tfRGB4;
3228   fRGBInverted      := tfBGRA4;
3229   fRange.r          := $F;
3230   fRange.g          := $F;
3231   fRange.b          := $F;
3232   fRange.a          := $F;
3233   fShift.r          :=  0;
3234   fShift.g          :=  4;
3235   fShift.b          :=  8;
3236   fShift.a          := 12;
3237   fglFormat         := GL_RGBA;
3238   fglInternalFormat := GL_RGBA4;
3239   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3240 end;
3241
3242 constructor TfdRGB5A1.Create;
3243 begin
3244   inherited Create;
3245   fFormat           := tfRGB5A1;
3246   fWithAlpha        := tfRGB5A1;
3247   fWithoutAlpha     := tfRGB5;
3248   fRGBInverted      := tfBGR5A1;
3249   fRange.r          := $1F;
3250   fRange.g          := $1F;
3251   fRange.b          := $1F;
3252   fRange.a          := $01;
3253   fShift.r          :=   0;
3254   fShift.g          :=   5;
3255   fShift.b          :=  10;
3256   fShift.a          :=  15;
3257   fglFormat         := GL_RGBA;
3258   fglInternalFormat := GL_RGB5_A1;
3259   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3260 end;
3261
3262 constructor TfdRGBA8.Create;
3263 begin
3264   inherited Create;
3265   fFormat           := tfRGBA8;
3266   fWithAlpha        := tfRGBA8;
3267   fWithoutAlpha     := tfRGB8;
3268   fRGBInverted      := tfBGRA8;
3269   fglInternalFormat := GL_RGBA8;
3270 end;
3271
3272 constructor TfdRGB10A2.Create;
3273 begin
3274   inherited Create;
3275   fFormat           := tfRGB10A2;
3276   fWithAlpha        := tfRGB10A2;
3277   fWithoutAlpha     := tfRGB10;
3278   fRGBInverted      := tfBGR10A2;
3279   fRange.r          := $3FF;
3280   fRange.g          := $3FF;
3281   fRange.b          := $3FF;
3282   fRange.a          := $003;
3283   fShift.r          :=    0;
3284   fShift.g          :=   10;
3285   fShift.b          :=   20;
3286   fShift.a          :=   30;
3287   fglFormat         := GL_RGBA;
3288   fglInternalFormat := GL_RGB10_A2;
3289   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3290 end;
3291
3292 constructor TfdRGBA12.Create;
3293 begin
3294   inherited Create;
3295   fFormat           := tfRGBA12;
3296   fWithAlpha        := tfRGBA12;
3297   fWithoutAlpha     := tfRGB12;
3298   fRGBInverted      := tfBGRA12;
3299   fglInternalFormat := GL_RGBA12;
3300 end;
3301
3302 constructor TfdRGBA16.Create;
3303 begin
3304   inherited Create;
3305   fFormat           := tfRGBA16;
3306   fWithAlpha        := tfRGBA16;
3307   fWithoutAlpha     := tfRGB16;
3308   fRGBInverted      := tfBGRA16;
3309   fglInternalFormat := GL_RGBA16;
3310 end;
3311
3312 constructor TfdBGR4.Create;
3313 begin
3314   inherited Create;
3315   fPixelSize        := 2.0;
3316   fFormat           := tfBGR4;
3317   fWithAlpha        := tfBGRA4;
3318   fWithoutAlpha     := tfBGR4;
3319   fRGBInverted      := tfRGB4;
3320   fRange.r          := $F;
3321   fRange.g          := $F;
3322   fRange.b          := $F;
3323   fRange.a          := $0;
3324   fShift.r          :=  8;
3325   fShift.g          :=  4;
3326   fShift.b          :=  0;
3327   fShift.a          :=  0;
3328   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3329   fglInternalFormat := GL_RGB4;
3330   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3331 end;
3332
3333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3336 constructor TfdB5G6R5.Create;
3337 begin
3338   inherited Create;
3339   fFormat           := tfB5G6R5;
3340   fWithAlpha        := tfBGRA4;
3341   fWithoutAlpha     := tfB5G6R5;
3342   fRGBInverted      := tfR5G6B5;
3343   fRange.r          := $1F;
3344   fRange.g          := $3F;
3345   fRange.b          := $1F;
3346   fShift.r          :=  11;
3347   fShift.g          :=   5;
3348   fShift.b          :=   0;
3349   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3350   fglInternalFormat := GL_RGB8;
3351   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3352 end;
3353
3354 constructor TfdBGR5.Create;
3355 begin
3356   inherited Create;
3357   fPixelSize        := 2.0;
3358   fFormat           := tfBGR5;
3359   fWithAlpha        := tfBGR5A1;
3360   fWithoutAlpha     := tfBGR5;
3361   fRGBInverted      := tfRGB5;
3362   fRange.r          := $1F;
3363   fRange.g          := $1F;
3364   fRange.b          := $1F;
3365   fRange.a          := $00;
3366   fShift.r          :=  10;
3367   fShift.g          :=   5;
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_RGB5;
3372   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3373 end;
3374
3375 constructor TfdBGR8.Create;
3376 begin
3377   inherited Create;
3378   fFormat           := tfBGR8;
3379   fWithAlpha        := tfBGRA8;
3380   fWithoutAlpha     := tfBGR8;
3381   fRGBInverted      := tfRGB8;
3382   fglInternalFormat := GL_RGB8;
3383 end;
3384
3385 constructor TfdBGR10.Create;
3386 begin
3387   inherited Create;
3388   fFormat           := tfBGR10;
3389   fWithAlpha        := tfBGR10A2;
3390   fWithoutAlpha     := tfBGR10;
3391   fRGBInverted      := tfRGB10;
3392   fRange.r          := $3FF;
3393   fRange.g          := $3FF;
3394   fRange.b          := $3FF;
3395   fRange.a          := $000;
3396   fShift.r          :=   20;
3397   fShift.g          :=   10;
3398   fShift.b          :=    0;
3399   fShift.a          :=    0;
3400   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3401   fglInternalFormat := GL_RGB10;
3402   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3403 end;
3404
3405 constructor TfdBGR12.Create;
3406 begin
3407   inherited Create;
3408   fFormat           := tfBGR12;
3409   fWithAlpha        := tfBGRA12;
3410   fWithoutAlpha     := tfBGR12;
3411   fRGBInverted      := tfRGB12;
3412   fglInternalFormat := GL_RGB12;
3413 end;
3414
3415 constructor TfdBGR16.Create;
3416 begin
3417   inherited Create;
3418   fFormat           := tfBGR16;
3419   fWithAlpha        := tfBGRA16;
3420   fWithoutAlpha     := tfBGR16;
3421   fRGBInverted      := tfRGB16;
3422   fglInternalFormat := GL_RGB16;
3423 end;
3424
3425 constructor TfdBGRA2.Create;
3426 begin
3427   inherited Create;
3428   fFormat           := tfBGRA2;
3429   fWithAlpha        := tfBGRA4;
3430   fWithoutAlpha     := tfBGR4;
3431   fRGBInverted      := tfRGBA2;
3432   fglInternalFormat := GL_RGBA2;
3433 end;
3434
3435 constructor TfdBGRA4.Create;
3436 begin
3437   inherited Create;
3438   fFormat           := tfBGRA4;
3439   fWithAlpha        := tfBGRA4;
3440   fWithoutAlpha     := tfBGR4;
3441   fRGBInverted      := tfRGBA4;
3442   fRange.r          := $F;
3443   fRange.g          := $F;
3444   fRange.b          := $F;
3445   fRange.a          := $F;
3446   fShift.r          :=  8;
3447   fShift.g          :=  4;
3448   fShift.b          :=  0;
3449   fShift.a          := 12;
3450   fglFormat         := GL_BGRA;
3451   fglInternalFormat := GL_RGBA4;
3452   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3453 end;
3454
3455 constructor TfdBGR5A1.Create;
3456 begin
3457   inherited Create;
3458   fFormat           := tfBGR5A1;
3459   fWithAlpha        := tfBGR5A1;
3460   fWithoutAlpha     := tfBGR5;
3461   fRGBInverted      := tfRGB5A1;
3462   fRange.r          := $1F;
3463   fRange.g          := $1F;
3464   fRange.b          := $1F;
3465   fRange.a          := $01;
3466   fShift.r          :=  10;
3467   fShift.g          :=   5;
3468   fShift.b          :=   0;
3469   fShift.a          :=  15;
3470   fglFormat         := GL_BGRA;
3471   fglInternalFormat := GL_RGB5_A1;
3472   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3473 end;
3474
3475 constructor TfdBGRA8.Create;
3476 begin
3477   inherited Create;
3478   fFormat           := tfBGRA8;
3479   fWithAlpha        := tfBGRA8;
3480   fWithoutAlpha     := tfBGR8;
3481   fRGBInverted      := tfRGBA8;
3482   fglInternalFormat := GL_RGBA8;
3483 end;
3484
3485 constructor TfdBGR10A2.Create;
3486 begin
3487   inherited Create;
3488   fFormat           := tfBGR10A2;
3489   fWithAlpha        := tfBGR10A2;
3490   fWithoutAlpha     := tfBGR10;
3491   fRGBInverted      := tfRGB10A2;
3492   fRange.r          := $3FF;
3493   fRange.g          := $3FF;
3494   fRange.b          := $3FF;
3495   fRange.a          := $003;
3496   fShift.r          :=   20;
3497   fShift.g          :=   10;
3498   fShift.b          :=    0;
3499   fShift.a          :=   30;
3500   fglFormat         := GL_BGRA;
3501   fglInternalFormat := GL_RGB10_A2;
3502   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3503 end;
3504
3505 constructor TfdBGRA12.Create;
3506 begin
3507   inherited Create;
3508   fFormat           := tfBGRA12;
3509   fWithAlpha        := tfBGRA12;
3510   fWithoutAlpha     := tfBGR12;
3511   fRGBInverted      := tfRGBA12;
3512   fglInternalFormat := GL_RGBA12;
3513 end;
3514
3515 constructor TfdBGRA16.Create;
3516 begin
3517   inherited Create;
3518   fFormat           := tfBGRA16;
3519   fWithAlpha        := tfBGRA16;
3520   fWithoutAlpha     := tfBGR16;
3521   fRGBInverted      := tfRGBA16;
3522   fglInternalFormat := GL_RGBA16;
3523 end;
3524
3525 constructor TfdDepth16.Create;
3526 begin
3527   inherited Create;
3528   fFormat           := tfDepth16;
3529   fWithAlpha        := tfEmpty;
3530   fWithoutAlpha     := tfDepth16;
3531   fglInternalFormat := GL_DEPTH_COMPONENT16;
3532 end;
3533
3534 constructor TfdDepth24.Create;
3535 begin
3536   inherited Create;
3537   fFormat           := tfDepth24;
3538   fWithAlpha        := tfEmpty;
3539   fWithoutAlpha     := tfDepth24;
3540   fglInternalFormat := GL_DEPTH_COMPONENT24;
3541 end;
3542
3543 constructor TfdDepth32.Create;
3544 begin
3545   inherited Create;
3546   fFormat           := tfDepth32;
3547   fWithAlpha        := tfEmpty;
3548   fWithoutAlpha     := tfDepth32;
3549   fglInternalFormat := GL_DEPTH_COMPONENT32;
3550 end;
3551
3552 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3553 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3554 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3555 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3556 begin
3557   raise EglBitmap.Create('mapping for compressed formats is not supported');
3558 end;
3559
3560 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3561 begin
3562   raise EglBitmap.Create('mapping for compressed formats is not supported');
3563 end;
3564
3565 constructor TfdS3tcDtx1RGBA.Create;
3566 begin
3567   inherited Create;
3568   fFormat           := tfS3tcDtx1RGBA;
3569   fWithAlpha        := tfS3tcDtx1RGBA;
3570   fUncompressed     := tfRGB5A1;
3571   fPixelSize        := 0.5;
3572   fIsCompressed     := true;
3573   fglFormat         := GL_COMPRESSED_RGBA;
3574   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3575   fglDataFormat     := GL_UNSIGNED_BYTE;
3576 end;
3577
3578 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3579 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3580 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3581 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3582 begin
3583   raise EglBitmap.Create('mapping for compressed formats is not supported');
3584 end;
3585
3586 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3587 begin
3588   raise EglBitmap.Create('mapping for compressed formats is not supported');
3589 end;
3590
3591 constructor TfdS3tcDtx3RGBA.Create;
3592 begin
3593   inherited Create;
3594   fFormat           := tfS3tcDtx3RGBA;
3595   fWithAlpha        := tfS3tcDtx3RGBA;
3596   fUncompressed     := tfRGBA8;
3597   fPixelSize        := 1.0;
3598   fIsCompressed     := true;
3599   fglFormat         := GL_COMPRESSED_RGBA;
3600   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3601   fglDataFormat     := GL_UNSIGNED_BYTE;
3602 end;
3603
3604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3605 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3606 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3607 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3608 begin
3609   raise EglBitmap.Create('mapping for compressed formats is not supported');
3610 end;
3611
3612 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3613 begin
3614   raise EglBitmap.Create('mapping for compressed formats is not supported');
3615 end;
3616
3617 constructor TfdS3tcDtx5RGBA.Create;
3618 begin
3619   inherited Create;
3620   fFormat           := tfS3tcDtx3RGBA;
3621   fWithAlpha        := tfS3tcDtx3RGBA;
3622   fUncompressed     := tfRGBA8;
3623   fPixelSize        := 1.0;
3624   fIsCompressed     := true;
3625   fglFormat         := GL_COMPRESSED_RGBA;
3626   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3627   fglDataFormat     := GL_UNSIGNED_BYTE;
3628 end;
3629
3630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3631 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3632 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3633 class procedure TFormatDescriptor.Init;
3634 begin
3635   if not Assigned(FormatDescriptorCS) then
3636     FormatDescriptorCS := TCriticalSection.Create;
3637 end;
3638
3639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3640 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3641 begin
3642   FormatDescriptorCS.Enter;
3643   try
3644     result := FormatDescriptors[aFormat];
3645     if not Assigned(result) then begin
3646       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3647       FormatDescriptors[aFormat] := result;
3648     end;
3649   finally
3650     FormatDescriptorCS.Leave;
3651   end;
3652 end;
3653
3654 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3655 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3656 begin
3657   result := Get(Get(aFormat).WithAlpha);
3658 end;
3659
3660 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3661 class procedure TFormatDescriptor.Clear;
3662 var
3663   f: TglBitmapFormat;
3664 begin
3665   FormatDescriptorCS.Enter;
3666   try
3667     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3668       FreeAndNil(FormatDescriptors[f]);
3669   finally
3670     FormatDescriptorCS.Leave;
3671   end;
3672 end;
3673
3674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3675 class procedure TFormatDescriptor.Finalize;
3676 begin
3677   Clear;
3678   FreeAndNil(FormatDescriptorCS);
3679 end;
3680
3681 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3682 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3683 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3684 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3685 begin
3686   Update(aValue, fRange.r, fShift.r);
3687 end;
3688
3689 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3690 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3691 begin
3692   Update(aValue, fRange.g, fShift.g);
3693 end;
3694
3695 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3696 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3697 begin
3698   Update(aValue, fRange.b, fShift.b);
3699 end;
3700
3701 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3702 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3703 begin
3704   Update(aValue, fRange.a, fShift.a);
3705 end;
3706
3707 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3708 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3709   aShift: Byte);
3710 begin
3711   aShift := 0;
3712   aRange := 0;
3713   if (aMask = 0) then
3714     exit;
3715   while (aMask > 0) and ((aMask and 1) = 0) do begin
3716     inc(aShift);
3717     aMask := aMask shr 1;
3718   end;
3719   aRange := 1;
3720   while (aMask > 0) do begin
3721     aRange := aRange shl 1;
3722     aMask  := aMask  shr 1;
3723   end;
3724   dec(aRange);
3725
3726   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3727 end;
3728
3729 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3730 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3731 var
3732   data: QWord;
3733   s: Integer;
3734 begin
3735   data :=
3736     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3737     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3738     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3739     ((aPixel.Data.a and fRange.a) shl fShift.a);
3740   s := Round(fPixelSize);
3741   case s of
3742     1:           aData^  := data;
3743     2:     PWord(aData)^ := data;
3744     4: PCardinal(aData)^ := data;
3745     8:    PQWord(aData)^ := data;
3746   else
3747     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3748   end;
3749   inc(aData, s);
3750 end;
3751
3752 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3753 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3754 var
3755   data: QWord;
3756   s, i: Integer;
3757 begin
3758   s := Round(fPixelSize);
3759   case s of
3760     1: data :=           aData^;
3761     2: data :=     PWord(aData)^;
3762     4: data := PCardinal(aData)^;
3763     8: data :=    PQWord(aData)^;
3764   else
3765     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3766   end;
3767   for i := 0 to 3 do
3768     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3769   inc(aData, s);
3770 end;
3771
3772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3773 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3775 procedure TbmpColorTableFormat.CreateColorTable;
3776 var
3777   i: Integer;
3778 begin
3779   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3780     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3781
3782   if (Format = tfLuminance4) then
3783     SetLength(fColorTable, 16)
3784   else
3785     SetLength(fColorTable, 256);
3786
3787   case Format of
3788     tfLuminance4: begin
3789       for i := 0 to High(fColorTable) do begin
3790         fColorTable[i].r := 16 * i;
3791         fColorTable[i].g := 16 * i;
3792         fColorTable[i].b := 16 * i;
3793         fColorTable[i].a := 0;
3794       end;
3795     end;
3796
3797     tfLuminance8: begin
3798       for i := 0 to High(fColorTable) do begin
3799         fColorTable[i].r := i;
3800         fColorTable[i].g := i;
3801         fColorTable[i].b := i;
3802         fColorTable[i].a := 0;
3803       end;
3804     end;
3805
3806     tfR3G3B2: begin
3807       for i := 0 to High(fColorTable) do begin
3808         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3809         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3810         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3811         fColorTable[i].a := 0;
3812       end;
3813     end;
3814   end;
3815 end;
3816
3817 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3818 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3819 var
3820   d: Byte;
3821 begin
3822   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3823     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3824
3825   case Format of
3826     tfLuminance4: begin
3827       if (aMapData = nil) then
3828         aData^ := 0;
3829       d := LuminanceWeight(aPixel) and Range.r;
3830       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3831       inc(PByte(aMapData), 4);
3832       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3833         inc(aData);
3834         aMapData := nil;
3835       end;
3836     end;
3837
3838     tfLuminance8: begin
3839       aData^ := LuminanceWeight(aPixel) and Range.r;
3840       inc(aData);
3841     end;
3842
3843     tfR3G3B2: begin
3844       aData^ := Round(
3845         ((aPixel.Data.r and Range.r) shl Shift.r) or
3846         ((aPixel.Data.g and Range.g) shl Shift.g) or
3847         ((aPixel.Data.b and Range.b) shl Shift.b));
3848       inc(aData);
3849     end;
3850   end;
3851 end;
3852
3853 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3854 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3855 var
3856   idx: QWord;
3857   s: Integer;
3858   bits: Byte;
3859   f: Single;
3860 begin
3861   s    := Trunc(fPixelSize);
3862   f    := fPixelSize - s;
3863   bits := Round(8 * f);
3864   case s of
3865     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3866     1: idx :=           aData^;
3867     2: idx :=     PWord(aData)^;
3868     4: idx := PCardinal(aData)^;
3869     8: idx :=    PQWord(aData)^;
3870   else
3871     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3872   end;
3873   if (idx >= Length(fColorTable)) then
3874     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3875   with fColorTable[idx] do begin
3876     aPixel.Data.r := r;
3877     aPixel.Data.g := g;
3878     aPixel.Data.b := b;
3879     aPixel.Data.a := a;
3880   end;
3881   inc(PByte(aMapData), bits);
3882   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3883     inc(aData, 1);
3884     dec(PByte(aMapData), 8);
3885   end;
3886   inc(aData, s);
3887 end;
3888
3889 destructor TbmpColorTableFormat.Destroy;
3890 begin
3891   SetLength(fColorTable, 0);
3892   inherited Destroy;
3893 end;
3894
3895 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3896 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3897 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3898 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3899 var
3900   i: Integer;
3901 begin
3902   for i := 0 to 3 do begin
3903     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3904       if (aSourceFD.Range.arr[i] > 0) then
3905         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3906       else
3907         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3908     end;
3909   end;
3910 end;
3911
3912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3913 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3914 begin
3915   with aFuncRec do begin
3916     if (Source.Range.r   > 0) then
3917       Dest.Data.r := Source.Data.r;
3918     if (Source.Range.g > 0) then
3919       Dest.Data.g := Source.Data.g;
3920     if (Source.Range.b  > 0) then
3921       Dest.Data.b := Source.Data.b;
3922     if (Source.Range.a > 0) then
3923       Dest.Data.a := Source.Data.a;
3924   end;
3925 end;
3926
3927 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3928 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3929 var
3930   i: Integer;
3931 begin
3932   with aFuncRec do begin
3933     for i := 0 to 3 do
3934       if (Source.Range.arr[i] > 0) then
3935         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
3936   end;
3937 end;
3938
3939 type
3940   TShiftData = packed record
3941     case Integer of
3942       0: (r, g, b, a: SmallInt);
3943       1: (arr: array[0..3] of SmallInt);
3944   end;
3945   PShiftData = ^TShiftData;
3946
3947 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3948 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3949 var
3950   i: Integer;
3951 begin
3952   with aFuncRec do
3953     for i := 0 to 3 do
3954       if (Source.Range.arr[i] > 0) then
3955         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
3956 end;
3957
3958 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3959 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
3960 begin
3961   with aFuncRec do begin
3962     Dest.Data := Source.Data;
3963     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
3964       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
3965       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
3966       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
3967     end;
3968     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
3969       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
3970     end;
3971   end;
3972 end;
3973
3974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3975 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
3976 var
3977   i: Integer;
3978 begin
3979   with aFuncRec do begin
3980     for i := 0 to 3 do
3981       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
3982   end;
3983 end;
3984
3985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3986 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3987 var
3988   Temp: Single;
3989 begin
3990   with FuncRec do begin
3991     if (FuncRec.Args = nil) then begin //source has no alpha
3992       Temp :=
3993         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
3994         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
3995         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
3996       Dest.Data.a := Round(Dest.Range.a * Temp);
3997     end else
3998       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
3999   end;
4000 end;
4001
4002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4003 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4004 type
4005   PglBitmapPixelData = ^TglBitmapPixelData;
4006 begin
4007   with FuncRec do begin
4008     Dest.Data.r := Source.Data.r;
4009     Dest.Data.g := Source.Data.g;
4010     Dest.Data.b := Source.Data.b;
4011
4012     with PglBitmapPixelData(Args)^ do
4013       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4014           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4015           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4016         Dest.Data.a := 0
4017       else
4018         Dest.Data.a := Dest.Range.a;
4019   end;
4020 end;
4021
4022 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4023 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4024 begin
4025   with FuncRec do begin
4026     Dest.Data.r := Source.Data.r;
4027     Dest.Data.g := Source.Data.g;
4028     Dest.Data.b := Source.Data.b;
4029     Dest.Data.a := PCardinal(Args)^;
4030   end;
4031 end;
4032
4033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4034 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4035 type
4036   PRGBPix = ^TRGBPix;
4037   TRGBPix = array [0..2] of byte;
4038 var
4039   Temp: Byte;
4040 begin
4041   while aWidth > 0 do begin
4042     Temp := PRGBPix(aData)^[0];
4043     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4044     PRGBPix(aData)^[2] := Temp;
4045
4046     if aHasAlpha then
4047       Inc(aData, 4)
4048     else
4049       Inc(aData, 3);
4050     dec(aWidth);
4051   end;
4052 end;
4053
4054 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4055 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4057 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4058 begin
4059   result := TFormatDescriptor.Get(Format);
4060 end;
4061
4062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4063 function TglBitmap.GetWidth: Integer;
4064 begin
4065   if (ffX in fDimension.Fields) then
4066     result := fDimension.X
4067   else
4068     result := -1;
4069 end;
4070
4071 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4072 function TglBitmap.GetHeight: Integer;
4073 begin
4074   if (ffY in fDimension.Fields) then
4075     result := fDimension.Y
4076   else
4077     result := -1;
4078 end;
4079
4080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4081 function TglBitmap.GetFileWidth: Integer;
4082 begin
4083   result := Max(1, Width);
4084 end;
4085
4086 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4087 function TglBitmap.GetFileHeight: Integer;
4088 begin
4089   result := Max(1, Height);
4090 end;
4091
4092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4093 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4094 begin
4095   if fCustomData = aValue then
4096     exit;
4097   fCustomData := aValue;
4098 end;
4099
4100 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4101 procedure TglBitmap.SetCustomName(const aValue: String);
4102 begin
4103   if fCustomName = aValue then
4104     exit;
4105   fCustomName := aValue;
4106 end;
4107
4108 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4109 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4110 begin
4111   if fCustomNameW = aValue then
4112     exit;
4113   fCustomNameW := aValue;
4114 end;
4115
4116 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4117 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4118 begin
4119   if fDeleteTextureOnFree = aValue then
4120     exit;
4121   fDeleteTextureOnFree := aValue;
4122 end;
4123
4124 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4125 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4126 begin
4127   if fFormat = aValue then
4128     exit;
4129   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4130     raise EglBitmapUnsupportedFormat.Create(Format);
4131   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4132 end;
4133
4134 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4135 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4136 begin
4137   if fFreeDataAfterGenTexture = aValue then
4138     exit;
4139   fFreeDataAfterGenTexture := aValue;
4140 end;
4141
4142 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4143 procedure TglBitmap.SetID(const aValue: Cardinal);
4144 begin
4145   if fID = aValue then
4146     exit;
4147   fID := aValue;
4148 end;
4149
4150 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4151 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4152 begin
4153   if fMipMap = aValue then
4154     exit;
4155   fMipMap := aValue;
4156 end;
4157
4158 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4159 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4160 begin
4161   if fTarget = aValue then
4162     exit;
4163   fTarget := aValue;
4164 end;
4165
4166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4167 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4168 var
4169   MaxAnisotropic: Integer;
4170 begin
4171   fAnisotropic := aValue;
4172   if (ID > 0) then begin
4173     if GL_EXT_texture_filter_anisotropic then begin
4174       if fAnisotropic > 0 then begin
4175         Bind(false);
4176         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4177         if aValue > MaxAnisotropic then
4178           fAnisotropic := MaxAnisotropic;
4179         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4180       end;
4181     end else begin
4182       fAnisotropic := 0;
4183     end;
4184   end;
4185 end;
4186
4187 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4188 procedure TglBitmap.CreateID;
4189 begin
4190   if (ID <> 0) then
4191     glDeleteTextures(1, @fID);
4192   glGenTextures(1, @fID);
4193   Bind(false);
4194 end;
4195
4196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4197 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4198 begin
4199   // Set Up Parameters
4200   SetWrap(fWrapS, fWrapT, fWrapR);
4201   SetFilter(fFilterMin, fFilterMag);
4202   SetAnisotropic(fAnisotropic);
4203   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4204
4205   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4206     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4207
4208   // Mip Maps Generation Mode
4209   aBuildWithGlu := false;
4210   if (MipMap = mmMipmap) then begin
4211     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4212       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4213     else
4214       aBuildWithGlu := true;
4215   end else if (MipMap = mmMipmapGlu) then
4216     aBuildWithGlu := true;
4217 end;
4218
4219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4220 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4221   const aWidth: Integer; const aHeight: Integer);
4222 var
4223   s: Single;
4224 begin
4225   if (Data <> aData) then begin
4226     if (Assigned(Data)) then
4227       FreeMem(Data);
4228     fData := aData;
4229   end;
4230
4231   FillChar(fDimension, SizeOf(fDimension), 0);
4232   if not Assigned(fData) then begin
4233     fFormat    := tfEmpty;
4234     fPixelSize := 0;
4235     fRowSize   := 0;
4236   end else begin
4237     if aWidth <> -1 then begin
4238       fDimension.Fields := fDimension.Fields + [ffX];
4239       fDimension.X := aWidth;
4240     end;
4241
4242     if aHeight <> -1 then begin
4243       fDimension.Fields := fDimension.Fields + [ffY];
4244       fDimension.Y := aHeight;
4245     end;
4246
4247     s := TFormatDescriptor.Get(aFormat).PixelSize;
4248     fFormat    := aFormat;
4249     fPixelSize := Ceil(s);
4250     fRowSize   := Ceil(s * aWidth);
4251   end;
4252 end;
4253
4254 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4255 function TglBitmap.FlipHorz: Boolean;
4256 begin
4257   result := false;
4258 end;
4259
4260 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4261 function TglBitmap.FlipVert: Boolean;
4262 begin
4263   result := false;
4264 end;
4265
4266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4267 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4268 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4269 procedure TglBitmap.AfterConstruction;
4270 begin
4271   inherited AfterConstruction;
4272
4273   fID         := 0;
4274   fTarget     := 0;
4275   fIsResident := false;
4276
4277   fFormat                  := glBitmapGetDefaultFormat;
4278   fMipMap                  := glBitmapDefaultMipmap;
4279   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4280   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4281
4282   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4283   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4284   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4285 end;
4286
4287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4288 procedure TglBitmap.BeforeDestruction;
4289 var
4290   NewData: PByte;
4291 begin
4292   NewData := nil;
4293   SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4294   if (fID > 0) and fDeleteTextureOnFree then
4295     glDeleteTextures(1, @fID);
4296   inherited BeforeDestruction;
4297 end;
4298
4299 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4300 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4301 var
4302   TempPos: Integer;
4303 begin
4304   if not Assigned(aResType) then begin
4305     TempPos   := Pos('.', aResource);
4306     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4307     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4308   end;
4309 end;
4310
4311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4312 procedure TglBitmap.LoadFromFile(const aFilename: String);
4313 var
4314   fs: TFileStream;
4315 begin
4316   if not FileExists(aFilename) then
4317     raise EglBitmap.Create('file does not exist: ' + aFilename);
4318   fFilename := aFilename;
4319   fs := TFileStream.Create(fFilename, fmOpenRead);
4320   try
4321     fs.Position := 0;
4322     LoadFromStream(fs);
4323   finally
4324     fs.Free;
4325   end;
4326 end;
4327
4328 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4329 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4330 begin
4331   {$IFDEF GLB_SUPPORT_PNG_READ}
4332   if not LoadPNG(aStream) then
4333   {$ENDIF}
4334   {$IFDEF GLB_SUPPORT_JPEG_READ}
4335   if not LoadJPEG(aStream) then
4336   {$ENDIF}
4337   if not LoadDDS(aStream) then
4338   if not LoadTGA(aStream) then
4339   if not LoadBMP(aStream) then
4340     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4341 end;
4342
4343 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4344 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4345   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4346 var
4347   tmpData: PByte;
4348   size: Integer;
4349 begin
4350   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4351   GetMem(tmpData, size);
4352   try
4353     FillChar(tmpData^, size, #$FF);
4354     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4355   except
4356     if Assigned(tmpData) then
4357       FreeMem(tmpData);
4358     raise;
4359   end;
4360   AddFunc(Self, aFunc, false, Format, aArgs);
4361 end;
4362
4363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4364 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4365 var
4366   rs: TResourceStream;
4367 begin
4368   PrepareResType(aResource, aResType);
4369   rs := TResourceStream.Create(aInstance, aResource, aResType);
4370   try
4371     LoadFromStream(rs);
4372   finally
4373     rs.Free;
4374   end;
4375 end;
4376
4377 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4378 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4379 var
4380   rs: TResourceStream;
4381 begin
4382   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4383   try
4384     LoadFromStream(rs);
4385   finally
4386     rs.Free;
4387   end;
4388 end;
4389
4390 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4391 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4392 var
4393   fs: TFileStream;
4394 begin
4395   fs := TFileStream.Create(aFileName, fmCreate);
4396   try
4397     fs.Position := 0;
4398     SaveToStream(fs, aFileType);
4399   finally
4400     fs.Free;
4401   end;
4402 end;
4403
4404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4405 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4406 begin
4407   case aFileType of
4408     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4409     ftPNG:  SavePNG(aStream);
4410     {$ENDIF}
4411     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4412     ftJPEG: SaveJPEG(aStream);
4413     {$ENDIF}
4414     ftDDS:  SaveDDS(aStream);
4415     ftTGA:  SaveTGA(aStream);
4416     ftBMP:  SaveBMP(aStream);
4417   end;
4418 end;
4419
4420 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4421 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4422 begin
4423   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4424 end;
4425
4426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4427 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4428   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4429 var
4430   DestData, TmpData, SourceData: pByte;
4431   TempHeight, TempWidth: Integer;
4432   SourceFD, DestFD: TFormatDescriptor;
4433   SourceMD, DestMD: Pointer;
4434
4435   FuncRec: TglBitmapFunctionRec;
4436 begin
4437   Assert(Assigned(Data));
4438   Assert(Assigned(aSource));
4439   Assert(Assigned(aSource.Data));
4440
4441   result := false;
4442   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4443     SourceFD := TFormatDescriptor.Get(aSource.Format);
4444     DestFD   := TFormatDescriptor.Get(aFormat);
4445
4446     if (SourceFD.IsCompressed) then
4447       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4448     if (DestFD.IsCompressed) then
4449       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4450
4451     // inkompatible Formats so CreateTemp
4452     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4453       aCreateTemp := true;
4454
4455     // Values
4456     TempHeight := Max(1, aSource.Height);
4457     TempWidth  := Max(1, aSource.Width);
4458
4459     FuncRec.Sender := Self;
4460     FuncRec.Args   := aArgs;
4461
4462     TmpData := nil;
4463     if aCreateTemp then begin
4464       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4465       DestData := TmpData;
4466     end else
4467       DestData := Data;
4468
4469     try
4470       SourceFD.PreparePixel(FuncRec.Source);
4471       DestFD.PreparePixel  (FuncRec.Dest);
4472
4473       SourceMD := SourceFD.CreateMappingData;
4474       DestMD   := DestFD.CreateMappingData;
4475
4476       FuncRec.Size            := aSource.Dimension;
4477       FuncRec.Position.Fields := FuncRec.Size.Fields;
4478
4479       try
4480         SourceData := aSource.Data;
4481         FuncRec.Position.Y := 0;
4482         while FuncRec.Position.Y < TempHeight do begin
4483           FuncRec.Position.X := 0;
4484           while FuncRec.Position.X < TempWidth do begin
4485             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4486             aFunc(FuncRec);
4487             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4488             inc(FuncRec.Position.X);
4489           end;
4490           inc(FuncRec.Position.Y);
4491         end;
4492
4493         // Updating Image or InternalFormat
4494         if aCreateTemp then
4495           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4496         else if (aFormat <> fFormat) then
4497           Format := aFormat;
4498
4499         result := true;
4500       finally
4501         SourceFD.FreeMappingData(SourceMD);
4502         DestFD.FreeMappingData(DestMD);
4503       end;
4504     except
4505       if aCreateTemp and Assigned(TmpData) then
4506         FreeMem(TmpData);
4507       raise;
4508     end;
4509   end;
4510 end;
4511
4512 {$IFDEF GLB_SDL}
4513 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4514 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4515 var
4516   Row, RowSize: Integer;
4517   SourceData, TmpData: PByte;
4518   TempDepth: Integer;
4519   FormatDesc: TFormatDescriptor;
4520
4521   function GetRowPointer(Row: Integer): pByte;
4522   begin
4523     result := aSurface.pixels;
4524     Inc(result, Row * RowSize);
4525   end;
4526
4527 begin
4528   result := false;
4529
4530   FormatDesc := TFormatDescriptor.Get(Format);
4531   if FormatDesc.IsCompressed then
4532     raise EglBitmapUnsupportedFormat.Create(Format);
4533
4534   if Assigned(Data) then begin
4535     case Trunc(FormatDesc.PixelSize) of
4536       1: TempDepth :=  8;
4537       2: TempDepth := 16;
4538       3: TempDepth := 24;
4539       4: TempDepth := 32;
4540     else
4541       raise EglBitmapUnsupportedFormat.Create(Format);
4542     end;
4543
4544     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4545       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4546     SourceData := Data;
4547     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4548
4549     for Row := 0 to FileHeight-1 do begin
4550       TmpData := GetRowPointer(Row);
4551       if Assigned(TmpData) then begin
4552         Move(SourceData^, TmpData^, RowSize);
4553         inc(SourceData, RowSize);
4554       end;
4555     end;
4556     result := true;
4557   end;
4558 end;
4559
4560 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4561 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4562 var
4563   pSource, pData, pTempData: PByte;
4564   Row, RowSize, TempWidth, TempHeight: Integer;
4565   IntFormat: TglBitmapFormat;
4566   FormatDesc: TFormatDescriptor;
4567
4568   function GetRowPointer(Row: Integer): pByte;
4569   begin
4570     result := aSurface^.pixels;
4571     Inc(result, Row * RowSize);
4572   end;
4573
4574 begin
4575   result := false;
4576   if (Assigned(aSurface)) then begin
4577     with aSurface^.format^ do begin
4578       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4579         FormatDesc := TFormatDescriptor.Get(IntFormat);
4580         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4581           break;
4582       end;
4583       if (IntFormat = tfEmpty) then
4584         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4585     end;
4586
4587     TempWidth  := aSurface^.w;
4588     TempHeight := aSurface^.h;
4589     RowSize := FormatDesc.GetSize(TempWidth, 1);
4590     GetMem(pData, TempHeight * RowSize);
4591     try
4592       pTempData := pData;
4593       for Row := 0 to TempHeight -1 do begin
4594         pSource := GetRowPointer(Row);
4595         if (Assigned(pSource)) then begin
4596           Move(pSource^, pTempData^, RowSize);
4597           Inc(pTempData, RowSize);
4598         end;
4599       end;
4600       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4601       result := true;
4602     except
4603       if Assigned(pData) then
4604         FreeMem(pData);
4605       raise;
4606     end;
4607   end;
4608 end;
4609
4610 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4611 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4612 var
4613   Row, Col, AlphaInterleave: Integer;
4614   pSource, pDest: PByte;
4615
4616   function GetRowPointer(Row: Integer): pByte;
4617   begin
4618     result := aSurface.pixels;
4619     Inc(result, Row * Width);
4620   end;
4621
4622 begin
4623   result := false;
4624   if Assigned(Data) then begin
4625     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4626       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4627
4628       AlphaInterleave := 0;
4629       case Format of
4630         tfLuminance8Alpha8:
4631           AlphaInterleave := 1;
4632         tfBGRA8, tfRGBA8:
4633           AlphaInterleave := 3;
4634       end;
4635
4636       pSource := Data;
4637       for Row := 0 to Height -1 do begin
4638         pDest := GetRowPointer(Row);
4639         if Assigned(pDest) then begin
4640           for Col := 0 to Width -1 do begin
4641             Inc(pSource, AlphaInterleave);
4642             pDest^ := pSource^;
4643             Inc(pDest);
4644             Inc(pSource);
4645           end;
4646         end;
4647       end;
4648       result := true;
4649     end;
4650   end;
4651 end;
4652
4653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4654 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4655 var
4656   bmp: TglBitmap2D;
4657 begin
4658   bmp := TglBitmap2D.Create;
4659   try
4660     bmp.AssignFromSurface(aSurface);
4661     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4662   finally
4663     bmp.Free;
4664   end;
4665 end;
4666 {$ENDIF}
4667
4668 {$IFDEF GLB_DELPHI}
4669 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4670 function CreateGrayPalette: HPALETTE;
4671 var
4672   Idx: Integer;
4673   Pal: PLogPalette;
4674 begin
4675   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4676
4677   Pal.palVersion := $300;
4678   Pal.palNumEntries := 256;
4679
4680   for Idx := 0 to Pal.palNumEntries - 1 do begin
4681     Pal.palPalEntry[Idx].peRed   := Idx;
4682     Pal.palPalEntry[Idx].peGreen := Idx;
4683     Pal.palPalEntry[Idx].peBlue  := Idx;
4684     Pal.palPalEntry[Idx].peFlags := 0;
4685   end;
4686   Result := CreatePalette(Pal^);
4687   FreeMem(Pal);
4688 end;
4689
4690 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4691 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4692 var
4693   Row: Integer;
4694   pSource, pData: PByte;
4695 begin
4696   result := false;
4697   if Assigned(Data) then begin
4698     if Assigned(aBitmap) then begin
4699       aBitmap.Width  := Width;
4700       aBitmap.Height := Height;
4701
4702       case Format of
4703         tfAlpha8, tfLuminance8: begin
4704           aBitmap.PixelFormat := pf8bit;
4705           aBitmap.Palette     := CreateGrayPalette;
4706         end;
4707         tfRGB5A1:
4708           aBitmap.PixelFormat := pf15bit;
4709         tfR5G6B5:
4710           aBitmap.PixelFormat := pf16bit;
4711         tfRGB8, tfBGR8:
4712           aBitmap.PixelFormat := pf24bit;
4713         tfRGBA8, tfBGRA8:
4714           aBitmap.PixelFormat := pf32bit;
4715       else
4716         raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4717       end;
4718
4719       pSource := Data;
4720       for Row := 0 to FileHeight -1 do begin
4721         pData := aBitmap.Scanline[Row];
4722         Move(pSource^, pData^, fRowSize);
4723         Inc(pSource, fRowSize);
4724         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4725           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4726       end;
4727       result := true;
4728     end;
4729   end;
4730 end;
4731
4732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4733 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4734 var
4735   pSource, pData, pTempData: PByte;
4736   Row, RowSize, TempWidth, TempHeight: Integer;
4737   IntFormat: TglBitmapFormat;
4738 begin
4739   result := false;
4740
4741   if (Assigned(aBitmap)) then begin
4742     case aBitmap.PixelFormat of
4743       pf8bit:
4744         IntFormat := tfLuminance8;
4745       pf15bit:
4746         IntFormat := tfRGB5A1;
4747       pf16bit:
4748         IntFormat := tfR5G6B5;
4749       pf24bit:
4750         IntFormat := tfBGR8;
4751       pf32bit:
4752         IntFormat := tfBGRA8;
4753     else
4754       raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4755     end;
4756
4757     TempWidth  := aBitmap.Width;
4758     TempHeight := aBitmap.Height;
4759     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4760     GetMem(pData, TempHeight * RowSize);
4761     try
4762       pTempData := pData;
4763       for Row := 0 to TempHeight -1 do begin
4764         pSource := aBitmap.Scanline[Row];
4765         if (Assigned(pSource)) then begin
4766           Move(pSource^, pTempData^, RowSize);
4767           Inc(pTempData, RowSize);
4768         end;
4769       end;
4770       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4771       result := true;
4772     except
4773       if Assigned(pData) then
4774         FreeMem(pData);
4775       raise;
4776     end;
4777   end;
4778 end;
4779
4780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4781 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4782 var
4783   Row, Col, AlphaInterleave: Integer;
4784   pSource, pDest: PByte;
4785 begin
4786   result := false;
4787
4788   if Assigned(Data) then begin
4789     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4790       if Assigned(aBitmap) then begin
4791         aBitmap.PixelFormat := pf8bit;
4792         aBitmap.Palette     := CreateGrayPalette;
4793         aBitmap.Width       := Width;
4794         aBitmap.Height      := Height;
4795
4796         case Format of
4797           tfLuminance8Alpha8:
4798             AlphaInterleave := 1;
4799           tfRGBA8, tfBGRA8:
4800             AlphaInterleave := 3;
4801           else
4802             AlphaInterleave := 0;
4803         end;
4804
4805         // Copy Data
4806         pSource := Data;
4807
4808         for Row := 0 to Height -1 do begin
4809           pDest := aBitmap.Scanline[Row];
4810           if Assigned(pDest) then begin
4811             for Col := 0 to Width -1 do begin
4812               Inc(pSource, AlphaInterleave);
4813               pDest^ := pSource^;
4814               Inc(pDest);
4815               Inc(pSource);
4816             end;
4817           end;
4818         end;
4819         result := true;
4820       end;
4821     end;
4822   end;
4823 end;
4824
4825 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4826 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4827 var
4828   tex: TglBitmap2D;
4829 begin
4830   tex := TglBitmap2D.Create;
4831   try
4832     tex.AssignFromBitmap(ABitmap);
4833     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4834   finally
4835     tex.Free;
4836   end;
4837 end;
4838 {$ENDIF}
4839
4840 {$IFDEF GLB_LAZARUS}
4841 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4842 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4843 var
4844   rid: TRawImageDescription;
4845   FormatDesc: TFormatDescriptor;
4846 begin
4847   result := false;
4848   if not Assigned(aImage) or (Format = tfEmpty) then
4849     exit;
4850   FormatDesc := TFormatDescriptor.Get(Format);
4851   if FormatDesc.IsCompressed then
4852     exit;
4853
4854   FillChar(rid{%H-}, SizeOf(rid), 0);
4855   if (Format in [
4856        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4857        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4858        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4859     rid.Format := ricfGray
4860   else
4861     rid.Format := ricfRGBA;
4862
4863   rid.Width        := Width;
4864   rid.Height       := Height;
4865   rid.Depth        := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
4866   rid.BitOrder     := riboBitsInOrder;
4867   rid.ByteOrder    := riboLSBFirst;
4868   rid.LineOrder    := riloTopToBottom;
4869   rid.LineEnd      := rileTight;
4870   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4871   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4872   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4873   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4874   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4875   rid.RedShift     := FormatDesc.Shift.r;
4876   rid.GreenShift   := FormatDesc.Shift.g;
4877   rid.BlueShift    := FormatDesc.Shift.b;
4878   rid.AlphaShift   := FormatDesc.Shift.a;
4879
4880   rid.MaskBitsPerPixel  := 0;
4881   rid.PaletteColorCount := 0;
4882
4883   aImage.DataDescription := rid;
4884   aImage.CreateData;
4885
4886   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4887
4888   result := true;
4889 end;
4890
4891 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4892 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4893 var
4894   f: TglBitmapFormat;
4895   FormatDesc: TFormatDescriptor;
4896   ImageData: PByte;
4897   ImageSize: Integer;
4898 begin
4899   result := false;
4900   if not Assigned(aImage) then
4901     exit;
4902   for f := High(f) downto Low(f) do begin
4903     FormatDesc := TFormatDescriptor.Get(f);
4904     with aImage.DataDescription do
4905       if FormatDesc.MaskMatch(
4906         (QWord(1 shl RedPrec  )-1) shl RedShift,
4907         (QWord(1 shl GreenPrec)-1) shl GreenShift,
4908         (QWord(1 shl BluePrec )-1) shl BlueShift,
4909         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
4910         break;
4911   end;
4912
4913   if (f = tfEmpty) then
4914     exit;
4915
4916   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
4917   ImageData := GetMem(ImageSize);
4918   try
4919     Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
4920     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
4921   except
4922     if Assigned(ImageData) then
4923       FreeMem(ImageData);
4924     raise;
4925   end;
4926
4927   result := true;
4928 end;
4929
4930 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4931 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4932 var
4933   rid: TRawImageDescription;
4934   FormatDesc: TFormatDescriptor;
4935   Pixel: TglBitmapPixelData;
4936   x, y: Integer;
4937   srcMD: Pointer;
4938   src, dst: PByte;
4939 begin
4940   result := false;
4941   if not Assigned(aImage) or (Format = tfEmpty) then
4942     exit;
4943   FormatDesc := TFormatDescriptor.Get(Format);
4944   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
4945     exit;
4946
4947   FillChar(rid{%H-}, SizeOf(rid), 0);
4948   rid.Format       := ricfGray;
4949   rid.Width        := Width;
4950   rid.Height       := Height;
4951   rid.Depth        := CountSetBits(FormatDesc.Range.a);
4952   rid.BitOrder     := riboBitsInOrder;
4953   rid.ByteOrder    := riboLSBFirst;
4954   rid.LineOrder    := riloTopToBottom;
4955   rid.LineEnd      := rileTight;
4956   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
4957   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
4958   rid.GreenPrec    := 0;
4959   rid.BluePrec     := 0;
4960   rid.AlphaPrec    := 0;
4961   rid.RedShift     := 0;
4962   rid.GreenShift   := 0;
4963   rid.BlueShift    := 0;
4964   rid.AlphaShift   := 0;
4965
4966   rid.MaskBitsPerPixel  := 0;
4967   rid.PaletteColorCount := 0;
4968
4969   aImage.DataDescription := rid;
4970   aImage.CreateData;
4971
4972   srcMD := FormatDesc.CreateMappingData;
4973   try
4974     FormatDesc.PreparePixel(Pixel);
4975     src := Data;
4976     dst := aImage.PixelData;
4977     for y := 0 to Height-1 do
4978       for x := 0 to Width-1 do begin
4979         FormatDesc.Unmap(src, Pixel, srcMD);
4980         case rid.BitsPerPixel of
4981            8: begin
4982             dst^ := Pixel.Data.a;
4983             inc(dst);
4984           end;
4985           16: begin
4986             PWord(dst)^ := Pixel.Data.a;
4987             inc(dst, 2);
4988           end;
4989           24: begin
4990             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
4991             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
4992             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
4993             inc(dst, 3);
4994           end;
4995           32: begin
4996             PCardinal(dst)^ := Pixel.Data.a;
4997             inc(dst, 4);
4998           end;
4999         else
5000           raise EglBitmapUnsupportedFormat.Create(Format);
5001         end;
5002       end;
5003   finally
5004     FormatDesc.FreeMappingData(srcMD);
5005   end;
5006   result := true;
5007 end;
5008
5009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5010 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5011 var
5012   tex: TglBitmap2D;
5013 begin
5014   tex := TglBitmap2D.Create;
5015   try
5016     tex.AssignFromLazIntfImage(aImage);
5017     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5018   finally
5019     tex.Free;
5020   end;
5021 end;
5022 {$ENDIF}
5023
5024 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5025 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5026   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5027 var
5028   rs: TResourceStream;
5029 begin
5030   PrepareResType(aResource, aResType);
5031   rs := TResourceStream.Create(aInstance, aResource, aResType);
5032   try
5033     result := AddAlphaFromStream(rs, aFunc, aArgs);
5034   finally
5035     rs.Free;
5036   end;
5037 end;
5038
5039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5040 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5041   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5042 var
5043   rs: TResourceStream;
5044 begin
5045   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5046   try
5047     result := AddAlphaFromStream(rs, aFunc, aArgs);
5048   finally
5049     rs.Free;
5050   end;
5051 end;
5052
5053 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5054 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5055 begin
5056   if TFormatDescriptor.Get(Format).IsCompressed then
5057     raise EglBitmapUnsupportedFormat.Create(Format);
5058   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5059 end;
5060
5061 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5062 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5063 var
5064   FS: TFileStream;
5065 begin
5066   FS := TFileStream.Create(aFileName, fmOpenRead);
5067   try
5068     result := AddAlphaFromStream(FS, aFunc, aArgs);
5069   finally
5070     FS.Free;
5071   end;
5072 end;
5073
5074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5075 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5076 var
5077   tex: TglBitmap2D;
5078 begin
5079   tex := TglBitmap2D.Create(aStream);
5080   try
5081     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5082   finally
5083     tex.Free;
5084   end;
5085 end;
5086
5087 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5088 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5089 var
5090   DestData, DestData2, SourceData: pByte;
5091   TempHeight, TempWidth: Integer;
5092   SourceFD, DestFD: TFormatDescriptor;
5093   SourceMD, DestMD, DestMD2: Pointer;
5094
5095   FuncRec: TglBitmapFunctionRec;
5096 begin
5097   result := false;
5098
5099   Assert(Assigned(Data));
5100   Assert(Assigned(aBitmap));
5101   Assert(Assigned(aBitmap.Data));
5102
5103   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5104     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5105
5106     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5107     DestFD   := TFormatDescriptor.Get(Format);
5108
5109     if not Assigned(aFunc) then begin
5110       aFunc        := glBitmapAlphaFunc;
5111       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5112     end else
5113       FuncRec.Args := aArgs;
5114
5115     // Values
5116     TempHeight := aBitmap.FileHeight;
5117     TempWidth  := aBitmap.FileWidth;
5118
5119     FuncRec.Sender          := Self;
5120     FuncRec.Size            := Dimension;
5121     FuncRec.Position.Fields := FuncRec.Size.Fields;
5122
5123     DestData   := Data;
5124     DestData2  := Data;
5125     SourceData := aBitmap.Data;
5126
5127     // Mapping
5128     SourceFD.PreparePixel(FuncRec.Source);
5129     DestFD.PreparePixel  (FuncRec.Dest);
5130
5131     SourceMD := SourceFD.CreateMappingData;
5132     DestMD   := DestFD.CreateMappingData;
5133     DestMD2  := DestFD.CreateMappingData;
5134     try
5135       FuncRec.Position.Y := 0;
5136       while FuncRec.Position.Y < TempHeight do begin
5137         FuncRec.Position.X := 0;
5138         while FuncRec.Position.X < TempWidth do begin
5139           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5140           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5141           aFunc(FuncRec);
5142           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5143           inc(FuncRec.Position.X);
5144         end;
5145         inc(FuncRec.Position.Y);
5146       end;
5147     finally
5148       SourceFD.FreeMappingData(SourceMD);
5149       DestFD.FreeMappingData(DestMD);
5150       DestFD.FreeMappingData(DestMD2);
5151     end;
5152   end;
5153 end;
5154
5155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5156 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5157 begin
5158   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5159 end;
5160
5161 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5162 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5163 var
5164   PixelData: TglBitmapPixelData;
5165 begin
5166   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5167   result := AddAlphaFromColorKeyFloat(
5168     aRed   / PixelData.Range.r,
5169     aGreen / PixelData.Range.g,
5170     aBlue  / PixelData.Range.b,
5171     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5172 end;
5173
5174 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5175 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5176 var
5177   values: array[0..2] of Single;
5178   tmp: Cardinal;
5179   i: Integer;
5180   PixelData: TglBitmapPixelData;
5181 begin
5182   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5183   with PixelData do begin
5184     values[0] := aRed;
5185     values[1] := aGreen;
5186     values[2] := aBlue;
5187
5188     for i := 0 to 2 do begin
5189       tmp          := Trunc(Range.arr[i] * aDeviation);
5190       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5191       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5192     end;
5193     Data.a  := 0;
5194     Range.a := 0;
5195   end;
5196   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5197 end;
5198
5199 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5200 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5201 begin
5202   result := AddAlphaFromValueFloat(aAlpha / $FF);
5203 end;
5204
5205 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5206 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5207 var
5208   PixelData: TglBitmapPixelData;
5209 begin
5210   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5211   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5212 end;
5213
5214 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5215 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5216 var
5217   PixelData: TglBitmapPixelData;
5218 begin
5219   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5220   with PixelData do
5221     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5222   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5223 end;
5224
5225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5226 function TglBitmap.RemoveAlpha: Boolean;
5227 var
5228   FormatDesc: TFormatDescriptor;
5229 begin
5230   result := false;
5231   FormatDesc := TFormatDescriptor.Get(Format);
5232   if Assigned(Data) then begin
5233     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5234       raise EglBitmapUnsupportedFormat.Create(Format);
5235     result := ConvertTo(FormatDesc.WithoutAlpha);
5236   end;
5237 end;
5238
5239 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5240 function TglBitmap.Clone: TglBitmap;
5241 var
5242   Temp: TglBitmap;
5243   TempPtr: PByte;
5244   Size: Integer;
5245 begin
5246   result := nil;
5247   Temp := (ClassType.Create as TglBitmap);
5248   try
5249     // copy texture data if assigned
5250     if Assigned(Data) then begin
5251       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5252       GetMem(TempPtr, Size);
5253       try
5254         Move(Data^, TempPtr^, Size);
5255         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5256       except
5257         if Assigned(TempPtr) then
5258           FreeMem(TempPtr);
5259         raise;
5260       end;
5261     end else begin
5262       TempPtr := nil;
5263       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5264     end;
5265
5266         // copy properties
5267     Temp.fID                      := ID;
5268     Temp.fTarget                  := Target;
5269     Temp.fFormat                  := Format;
5270     Temp.fMipMap                  := MipMap;
5271     Temp.fAnisotropic             := Anisotropic;
5272     Temp.fBorderColor             := fBorderColor;
5273     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5274     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5275     Temp.fFilterMin               := fFilterMin;
5276     Temp.fFilterMag               := fFilterMag;
5277     Temp.fWrapS                   := fWrapS;
5278     Temp.fWrapT                   := fWrapT;
5279     Temp.fWrapR                   := fWrapR;
5280     Temp.fFilename                := fFilename;
5281     Temp.fCustomName              := fCustomName;
5282     Temp.fCustomNameW             := fCustomNameW;
5283     Temp.fCustomData              := fCustomData;
5284
5285     result := Temp;
5286   except
5287     FreeAndNil(Temp);
5288     raise;
5289   end;
5290 end;
5291
5292 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5293 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5294 var
5295   SourceFD, DestFD: TFormatDescriptor;
5296   SourcePD, DestPD: TglBitmapPixelData;
5297   ShiftData: TShiftData;
5298
5299   function CanCopyDirect: Boolean;
5300   begin
5301     result :=
5302       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5303       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5304       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5305       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5306   end;
5307
5308   function CanShift: Boolean;
5309   begin
5310     result :=
5311       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5312       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5313       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5314       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5315   end;
5316
5317   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5318   begin
5319     result := 0;
5320     while (aSource > aDest) and (aSource > 0) do begin
5321       inc(result);
5322       aSource := aSource shr 1;
5323     end;
5324   end;
5325
5326 begin
5327   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5328     SourceFD := TFormatDescriptor.Get(Format);
5329     DestFD   := TFormatDescriptor.Get(aFormat);
5330
5331     SourceFD.PreparePixel(SourcePD);
5332     DestFD.PreparePixel  (DestPD);
5333
5334     if CanCopyDirect then
5335       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5336     else if CanShift then begin
5337       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5338       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5339       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5340       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5341       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5342     end else
5343       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5344   end else
5345     result := true;
5346 end;
5347
5348 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5349 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5350 begin
5351   if aUseRGB or aUseAlpha then
5352     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5353       ((PtrInt(aUseAlpha) and 1) shl 1) or
5354        (PtrInt(aUseRGB)   and 1)      ));
5355 end;
5356
5357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5358 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5359 begin
5360   fBorderColor[0] := aRed;
5361   fBorderColor[1] := aGreen;
5362   fBorderColor[2] := aBlue;
5363   fBorderColor[3] := aAlpha;
5364   if (ID > 0) then begin
5365     Bind(false);
5366     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5367   end;
5368 end;
5369
5370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5371 procedure TglBitmap.FreeData;
5372 var
5373   TempPtr: PByte;
5374 begin
5375   TempPtr := nil;
5376   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5377 end;
5378
5379 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5380 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5381   const aAlpha: Byte);
5382 begin
5383   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5384 end;
5385
5386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5387 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5388 var
5389   PixelData: TglBitmapPixelData;
5390 begin
5391   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5392   FillWithColorFloat(
5393     aRed   / PixelData.Range.r,
5394     aGreen / PixelData.Range.g,
5395     aBlue  / PixelData.Range.b,
5396     aAlpha / PixelData.Range.a);
5397 end;
5398
5399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5400 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5401 var
5402   PixelData: TglBitmapPixelData;
5403 begin
5404   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5405   with PixelData do begin
5406     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5407     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5408     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5409     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5410   end;
5411   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5412 end;
5413
5414 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5415 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5416 begin
5417   //check MIN filter
5418   case aMin of
5419     GL_NEAREST:
5420       fFilterMin := GL_NEAREST;
5421     GL_LINEAR:
5422       fFilterMin := GL_LINEAR;
5423     GL_NEAREST_MIPMAP_NEAREST:
5424       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5425     GL_LINEAR_MIPMAP_NEAREST:
5426       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5427     GL_NEAREST_MIPMAP_LINEAR:
5428       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5429     GL_LINEAR_MIPMAP_LINEAR:
5430       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5431     else
5432       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5433   end;
5434
5435   //check MAG filter
5436   case aMag of
5437     GL_NEAREST:
5438       fFilterMag := GL_NEAREST;
5439     GL_LINEAR:
5440       fFilterMag := GL_LINEAR;
5441     else
5442       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5443   end;
5444
5445   //apply filter
5446   if (ID > 0) then begin
5447     Bind(false);
5448     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5449
5450     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5451       case fFilterMin of
5452         GL_NEAREST, GL_LINEAR:
5453           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5454         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5455           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5456         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5457           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5458       end;
5459     end else
5460       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5461   end;
5462 end;
5463
5464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5465 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5466
5467   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5468   begin
5469     case aValue of
5470       GL_CLAMP:
5471         aTarget := GL_CLAMP;
5472
5473       GL_REPEAT:
5474         aTarget := GL_REPEAT;
5475
5476       GL_CLAMP_TO_EDGE: begin
5477         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5478           aTarget := GL_CLAMP_TO_EDGE
5479         else
5480           aTarget := GL_CLAMP;
5481       end;
5482
5483       GL_CLAMP_TO_BORDER: begin
5484         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5485           aTarget := GL_CLAMP_TO_BORDER
5486         else
5487           aTarget := GL_CLAMP;
5488       end;
5489
5490       GL_MIRRORED_REPEAT: begin
5491         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5492           aTarget := GL_MIRRORED_REPEAT
5493         else
5494           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5495       end;
5496     else
5497       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5498     end;
5499   end;
5500
5501 begin
5502   CheckAndSetWrap(S, fWrapS);
5503   CheckAndSetWrap(T, fWrapT);
5504   CheckAndSetWrap(R, fWrapR);
5505
5506   if (ID > 0) then begin
5507     Bind(false);
5508     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5509     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5510     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5511   end;
5512 end;
5513
5514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5515 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5516
5517   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5518   begin
5519     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5520        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5521       fSwizzle[aIndex] := aValue
5522     else
5523       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5524   end;
5525
5526 begin
5527   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5528     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5529   CheckAndSetValue(r, 0);
5530   CheckAndSetValue(g, 1);
5531   CheckAndSetValue(b, 2);
5532   CheckAndSetValue(a, 3);
5533
5534   if (ID > 0) then begin
5535     Bind(false);
5536     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
5537   end;
5538 end;
5539
5540 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5541 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5542 begin
5543   if aEnableTextureUnit then
5544     glEnable(Target);
5545   if (ID > 0) then
5546     glBindTexture(Target, ID);
5547 end;
5548
5549 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5550 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5551 begin
5552   if aDisableTextureUnit then
5553     glDisable(Target);
5554   glBindTexture(Target, 0);
5555 end;
5556
5557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5558 constructor TglBitmap.Create;
5559 begin
5560   if (ClassType = TglBitmap) then
5561     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5562 {$IFDEF GLB_NATIVE_OGL}
5563   glbReadOpenGLExtensions;
5564 {$ENDIF}
5565   inherited Create;
5566 end;
5567
5568 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5569 constructor TglBitmap.Create(const aFileName: String);
5570 begin
5571   Create;
5572   LoadFromFile(aFileName);
5573 end;
5574
5575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5576 constructor TglBitmap.Create(const aStream: TStream);
5577 begin
5578   Create;
5579   LoadFromStream(aStream);
5580 end;
5581
5582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5583 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5584 var
5585   Image: PByte;
5586   ImageSize: Integer;
5587 begin
5588   Create;
5589   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5590   GetMem(Image, ImageSize);
5591   try
5592     FillChar(Image^, ImageSize, #$FF);
5593     SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5594   except
5595     if Assigned(Image) then
5596       FreeMem(Image);
5597     raise;
5598   end;
5599 end;
5600
5601 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5602 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5603   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5604 begin
5605   Create;
5606   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5607 end;
5608
5609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5610 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5611 begin
5612   Create;
5613   LoadFromResource(aInstance, aResource, aResType);
5614 end;
5615
5616 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5617 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5618 begin
5619   Create;
5620   LoadFromResourceID(aInstance, aResourceID, aResType);
5621 end;
5622
5623 {$IFDEF GLB_SUPPORT_PNG_READ}
5624 {$IF DEFINED(GLB_SDL_IMAGE)}
5625 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5626 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5627 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5628 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5629 var
5630   Surface: PSDL_Surface;
5631   RWops: PSDL_RWops;
5632 begin
5633   result := false;
5634   RWops := glBitmapCreateRWops(aStream);
5635   try
5636     if IMG_isPNG(RWops) > 0 then begin
5637       Surface := IMG_LoadPNG_RW(RWops);
5638       try
5639         AssignFromSurface(Surface);
5640         result := true;
5641       finally
5642         SDL_FreeSurface(Surface);
5643       end;
5644     end;
5645   finally
5646     SDL_FreeRW(RWops);
5647   end;
5648 end;
5649
5650 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5651 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5652 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5653 begin
5654   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5655 end;
5656
5657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5658 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5659 var
5660   StreamPos: Int64;
5661   signature: array [0..7] of byte;
5662   png: png_structp;
5663   png_info: png_infop;
5664
5665   TempHeight, TempWidth: Integer;
5666   Format: TglBitmapFormat;
5667
5668   png_data: pByte;
5669   png_rows: array of pByte;
5670   Row, LineSize: Integer;
5671 begin
5672   result := false;
5673
5674   if not init_libPNG then
5675     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5676
5677   try
5678     // signature
5679     StreamPos := aStream.Position;
5680     aStream.Read(signature{%H-}, 8);
5681     aStream.Position := StreamPos;
5682
5683     if png_check_sig(@signature, 8) <> 0 then begin
5684       // png read struct
5685       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5686       if png = nil then
5687         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5688
5689       // png info
5690       png_info := png_create_info_struct(png);
5691       if png_info = nil then begin
5692         png_destroy_read_struct(@png, nil, nil);
5693         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5694       end;
5695
5696       // set read callback
5697       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5698
5699       // read informations
5700       png_read_info(png, png_info);
5701
5702       // size
5703       TempHeight := png_get_image_height(png, png_info);
5704       TempWidth := png_get_image_width(png, png_info);
5705
5706       // format
5707       case png_get_color_type(png, png_info) of
5708         PNG_COLOR_TYPE_GRAY:
5709           Format := tfLuminance8;
5710         PNG_COLOR_TYPE_GRAY_ALPHA:
5711           Format := tfLuminance8Alpha8;
5712         PNG_COLOR_TYPE_RGB:
5713           Format := tfRGB8;
5714         PNG_COLOR_TYPE_RGB_ALPHA:
5715           Format := tfRGBA8;
5716         else
5717           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5718       end;
5719
5720       // cut upper 8 bit from 16 bit formats
5721       if png_get_bit_depth(png, png_info) > 8 then
5722         png_set_strip_16(png);
5723
5724       // expand bitdepth smaller than 8
5725       if png_get_bit_depth(png, png_info) < 8 then
5726         png_set_expand(png);
5727
5728       // allocating mem for scanlines
5729       LineSize := png_get_rowbytes(png, png_info);
5730       GetMem(png_data, TempHeight * LineSize);
5731       try
5732         SetLength(png_rows, TempHeight);
5733         for Row := Low(png_rows) to High(png_rows) do begin
5734           png_rows[Row] := png_data;
5735           Inc(png_rows[Row], Row * LineSize);
5736         end;
5737
5738         // read complete image into scanlines
5739         png_read_image(png, @png_rows[0]);
5740
5741         // read end
5742         png_read_end(png, png_info);
5743
5744         // destroy read struct
5745         png_destroy_read_struct(@png, @png_info, nil);
5746
5747         SetLength(png_rows, 0);
5748
5749         // set new data
5750         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5751
5752         result := true;
5753       except
5754         if Assigned(png_data) then
5755           FreeMem(png_data);
5756         raise;
5757       end;
5758     end;
5759   finally
5760     quit_libPNG;
5761   end;
5762 end;
5763
5764 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5766 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5767 var
5768   StreamPos: Int64;
5769   Png: TPNGObject;
5770   Header: String[8];
5771   Row, Col, PixSize, LineSize: Integer;
5772   NewImage, pSource, pDest, pAlpha: pByte;
5773   PngFormat: TglBitmapFormat;
5774   FormatDesc: TFormatDescriptor;
5775
5776 const
5777   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5778
5779 begin
5780   result := false;
5781
5782   StreamPos := aStream.Position;
5783   aStream.Read(Header[0], SizeOf(Header));
5784   aStream.Position := StreamPos;
5785
5786   {Test if the header matches}
5787   if Header = PngHeader then begin
5788     Png := TPNGObject.Create;
5789     try
5790       Png.LoadFromStream(aStream);
5791
5792       case Png.Header.ColorType of
5793         COLOR_GRAYSCALE:
5794           PngFormat := tfLuminance8;
5795         COLOR_GRAYSCALEALPHA:
5796           PngFormat := tfLuminance8Alpha8;
5797         COLOR_RGB:
5798           PngFormat := tfBGR8;
5799         COLOR_RGBALPHA:
5800           PngFormat := tfBGRA8;
5801         else
5802           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5803       end;
5804
5805       FormatDesc := TFormatDescriptor.Get(PngFormat);
5806       PixSize    := Round(FormatDesc.PixelSize);
5807       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5808
5809       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5810       try
5811         pDest := NewImage;
5812
5813         case Png.Header.ColorType of
5814           COLOR_RGB, COLOR_GRAYSCALE:
5815             begin
5816               for Row := 0 to Png.Height -1 do begin
5817                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5818                 Inc(pDest, LineSize);
5819               end;
5820             end;
5821           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5822             begin
5823               PixSize := PixSize -1;
5824
5825               for Row := 0 to Png.Height -1 do begin
5826                 pSource := Png.Scanline[Row];
5827                 pAlpha := pByte(Png.AlphaScanline[Row]);
5828
5829                 for Col := 0 to Png.Width -1 do begin
5830                   Move (pSource^, pDest^, PixSize);
5831                   Inc(pSource, PixSize);
5832                   Inc(pDest, PixSize);
5833
5834                   pDest^ := pAlpha^;
5835                   inc(pAlpha);
5836                   Inc(pDest);
5837                 end;
5838               end;
5839             end;
5840           else
5841             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5842         end;
5843
5844         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
5845
5846         result := true;
5847       except
5848         if Assigned(NewImage) then
5849           FreeMem(NewImage);
5850         raise;
5851       end;
5852     finally
5853       Png.Free;
5854     end;
5855   end;
5856 end;
5857 {$IFEND}
5858 {$ENDIF}
5859
5860 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5861 {$IFDEF GLB_LIB_PNG}
5862 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5863 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5864 begin
5865   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5866 end;
5867 {$ENDIF}
5868
5869 {$IF DEFINED(GLB_LIB_PNG)}
5870 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5871 procedure TglBitmap.SavePNG(const aStream: TStream);
5872 var
5873   png: png_structp;
5874   png_info: png_infop;
5875   png_rows: array of pByte;
5876   LineSize: Integer;
5877   ColorType: Integer;
5878   Row: Integer;
5879   FormatDesc: TFormatDescriptor;
5880 begin
5881   if not (ftPNG in FormatGetSupportedFiles(Format)) then
5882     raise EglBitmapUnsupportedFormat.Create(Format);
5883
5884   if not init_libPNG then
5885     raise Exception.Create('unable to initialize libPNG.');
5886
5887   try
5888     case Format of
5889       tfAlpha8, tfLuminance8:
5890         ColorType := PNG_COLOR_TYPE_GRAY;
5891       tfLuminance8Alpha8:
5892         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5893       tfBGR8, tfRGB8:
5894         ColorType := PNG_COLOR_TYPE_RGB;
5895       tfBGRA8, tfRGBA8:
5896         ColorType := PNG_COLOR_TYPE_RGBA;
5897       else
5898         raise EglBitmapUnsupportedFormat.Create(Format);
5899     end;
5900
5901     FormatDesc := TFormatDescriptor.Get(Format);
5902     LineSize := FormatDesc.GetSize(Width, 1);
5903
5904     // creating array for scanline
5905     SetLength(png_rows, Height);
5906     try
5907       for Row := 0 to Height - 1 do begin
5908         png_rows[Row] := Data;
5909         Inc(png_rows[Row], Row * LineSize)
5910       end;
5911
5912       // write struct
5913       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5914       if png = nil then
5915         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5916
5917       // create png info
5918       png_info := png_create_info_struct(png);
5919       if png_info = nil then begin
5920         png_destroy_write_struct(@png, nil);
5921         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5922       end;
5923
5924       // set read callback
5925       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
5926
5927       // set compression
5928       png_set_compression_level(png, 6);
5929
5930       if Format in [tfBGR8, tfBGRA8] then
5931         png_set_bgr(png);
5932
5933       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5934       png_write_info(png, png_info);
5935       png_write_image(png, @png_rows[0]);
5936       png_write_end(png, png_info);
5937       png_destroy_write_struct(@png, @png_info);
5938     finally
5939       SetLength(png_rows, 0);
5940     end;
5941   finally
5942     quit_libPNG;
5943   end;
5944 end;
5945
5946 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5947 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5948 procedure TglBitmap.SavePNG(const aStream: TStream);
5949 var
5950   Png: TPNGObject;
5951
5952   pSource, pDest: pByte;
5953   X, Y, PixSize: Integer;
5954   ColorType: Cardinal;
5955   Alpha: Boolean;
5956
5957   pTemp: pByte;
5958   Temp: Byte;
5959 begin
5960   if not (ftPNG in FormatGetSupportedFiles (Format)) then
5961     raise EglBitmapUnsupportedFormat.Create(Format);
5962
5963   case Format of
5964     tfAlpha8, tfLuminance8: begin
5965       ColorType := COLOR_GRAYSCALE;
5966       PixSize   := 1;
5967       Alpha     := false;
5968     end;
5969     tfLuminance8Alpha8: begin
5970       ColorType := COLOR_GRAYSCALEALPHA;
5971       PixSize   := 1;
5972       Alpha     := true;
5973     end;
5974     tfBGR8, tfRGB8: begin
5975       ColorType := COLOR_RGB;
5976       PixSize   := 3;
5977       Alpha     := false;
5978     end;
5979     tfBGRA8, tfRGBA8: begin
5980       ColorType := COLOR_RGBALPHA;
5981       PixSize   := 3;
5982       Alpha     := true
5983     end;
5984   else
5985     raise EglBitmapUnsupportedFormat.Create(Format);
5986   end;
5987
5988   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5989   try
5990     // Copy ImageData
5991     pSource := Data;
5992     for Y := 0 to Height -1 do begin
5993       pDest := png.ScanLine[Y];
5994       for X := 0 to Width -1 do begin
5995         Move(pSource^, pDest^, PixSize);
5996         Inc(pDest, PixSize);
5997         Inc(pSource, PixSize);
5998         if Alpha then begin
5999           png.AlphaScanline[Y]^[X] := pSource^;
6000           Inc(pSource);
6001         end;
6002       end;
6003
6004       // convert RGB line to BGR
6005       if Format in [tfRGB8, tfRGBA8] then begin
6006         pTemp := png.ScanLine[Y];
6007         for X := 0 to Width -1 do begin
6008           Temp := pByteArray(pTemp)^[0];
6009           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6010           pByteArray(pTemp)^[2] := Temp;
6011           Inc(pTemp, 3);
6012         end;
6013       end;
6014     end;
6015
6016     // Save to Stream
6017     Png.CompressionLevel := 6;
6018     Png.SaveToStream(aStream);
6019   finally
6020     FreeAndNil(Png);
6021   end;
6022 end;
6023 {$IFEND}
6024 {$ENDIF}
6025
6026 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6027 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6028 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6029 {$IFDEF GLB_LIB_JPEG}
6030 type
6031   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6032   glBitmap_libJPEG_source_mgr = record
6033     pub: jpeg_source_mgr;
6034
6035     SrcStream: TStream;
6036     SrcBuffer: array [1..4096] of byte;
6037   end;
6038
6039   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6040   glBitmap_libJPEG_dest_mgr = record
6041     pub: jpeg_destination_mgr;
6042
6043     DestStream: TStream;
6044     DestBuffer: array [1..4096] of byte;
6045   end;
6046
6047 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6048 begin
6049   //DUMMY
6050 end;
6051
6052
6053 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6054 begin
6055   //DUMMY
6056 end;
6057
6058
6059 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6060 begin
6061   //DUMMY
6062 end;
6063
6064 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6065 begin
6066   //DUMMY
6067 end;
6068
6069
6070 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6071 begin
6072   //DUMMY
6073 end;
6074
6075
6076 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6077 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6078 var
6079   src: glBitmap_libJPEG_source_mgr_ptr;
6080   bytes: integer;
6081 begin
6082   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6083
6084   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6085         if (bytes <= 0) then begin
6086                 src^.SrcBuffer[1] := $FF;
6087                 src^.SrcBuffer[2] := JPEG_EOI;
6088                 bytes := 2;
6089         end;
6090
6091         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6092         src^.pub.bytes_in_buffer := bytes;
6093
6094   result := true;
6095 end;
6096
6097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6098 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6099 var
6100   src: glBitmap_libJPEG_source_mgr_ptr;
6101 begin
6102   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6103
6104   if num_bytes > 0 then begin
6105     // wanted byte isn't in buffer so set stream position and read buffer
6106     if num_bytes > src^.pub.bytes_in_buffer then begin
6107       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6108       src^.pub.fill_input_buffer(cinfo);
6109     end else begin
6110       // wanted byte is in buffer so only skip
6111                 inc(src^.pub.next_input_byte, num_bytes);
6112                 dec(src^.pub.bytes_in_buffer, num_bytes);
6113     end;
6114   end;
6115 end;
6116
6117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6118 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6119 var
6120   dest: glBitmap_libJPEG_dest_mgr_ptr;
6121 begin
6122   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6123
6124   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6125     // write complete buffer
6126     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6127
6128     // reset buffer
6129     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6130     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6131   end;
6132
6133   result := true;
6134 end;
6135
6136 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6137 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6138 var
6139   Idx: Integer;
6140   dest: glBitmap_libJPEG_dest_mgr_ptr;
6141 begin
6142   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6143
6144   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6145     // check for endblock
6146     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6147       // write endblock
6148       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6149
6150       // leave
6151       break;
6152     end else
6153       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6154   end;
6155 end;
6156 {$ENDIF}
6157
6158 {$IFDEF GLB_SUPPORT_JPEG_READ}
6159 {$IF DEFINED(GLB_SDL_IMAGE)}
6160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6161 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6162 var
6163   Surface: PSDL_Surface;
6164   RWops: PSDL_RWops;
6165 begin
6166   result := false;
6167
6168   RWops := glBitmapCreateRWops(aStream);
6169   try
6170     if IMG_isJPG(RWops) > 0 then begin
6171       Surface := IMG_LoadJPG_RW(RWops);
6172       try
6173         AssignFromSurface(Surface);
6174         result := true;
6175       finally
6176         SDL_FreeSurface(Surface);
6177       end;
6178     end;
6179   finally
6180     SDL_FreeRW(RWops);
6181   end;
6182 end;
6183
6184 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6185 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6186 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6187 var
6188   StreamPos: Int64;
6189   Temp: array[0..1]of Byte;
6190
6191   jpeg: jpeg_decompress_struct;
6192   jpeg_err: jpeg_error_mgr;
6193
6194   IntFormat: TglBitmapFormat;
6195   pImage: pByte;
6196   TempHeight, TempWidth: Integer;
6197
6198   pTemp: pByte;
6199   Row: Integer;
6200
6201   FormatDesc: TFormatDescriptor;
6202 begin
6203   result := false;
6204
6205   if not init_libJPEG then
6206     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6207
6208   try
6209     // reading first two bytes to test file and set cursor back to begin
6210     StreamPos := aStream.Position;
6211     aStream.Read({%H-}Temp[0], 2);
6212     aStream.Position := StreamPos;
6213
6214     // if Bitmap then read file.
6215     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6216       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6217       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6218
6219       // error managment
6220       jpeg.err := jpeg_std_error(@jpeg_err);
6221       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6222       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6223
6224       // decompression struct
6225       jpeg_create_decompress(@jpeg);
6226
6227       // allocation space for streaming methods
6228       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6229
6230       // seeting up custom functions
6231       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6232         pub.init_source       := glBitmap_libJPEG_init_source;
6233         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6234         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6235         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6236         pub.term_source       := glBitmap_libJPEG_term_source;
6237
6238         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6239         pub.next_input_byte := nil;   // until buffer loaded
6240
6241         SrcStream := aStream;
6242       end;
6243
6244       // set global decoding state
6245       jpeg.global_state := DSTATE_START;
6246
6247       // read header of jpeg
6248       jpeg_read_header(@jpeg, false);
6249
6250       // setting output parameter
6251       case jpeg.jpeg_color_space of
6252         JCS_GRAYSCALE:
6253           begin
6254             jpeg.out_color_space := JCS_GRAYSCALE;
6255             IntFormat := tfLuminance8;
6256           end;
6257         else
6258           jpeg.out_color_space := JCS_RGB;
6259           IntFormat := tfRGB8;
6260       end;
6261
6262       // reading image
6263       jpeg_start_decompress(@jpeg);
6264
6265       TempHeight := jpeg.output_height;
6266       TempWidth := jpeg.output_width;
6267
6268       FormatDesc := TFormatDescriptor.Get(IntFormat);
6269
6270       // creating new image
6271       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6272       try
6273         pTemp := pImage;
6274
6275         for Row := 0 to TempHeight -1 do begin
6276           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6277           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6278         end;
6279
6280         // finish decompression
6281         jpeg_finish_decompress(@jpeg);
6282
6283         // destroy decompression
6284         jpeg_destroy_decompress(@jpeg);
6285
6286         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6287
6288         result := true;
6289       except
6290         if Assigned(pImage) then
6291           FreeMem(pImage);
6292         raise;
6293       end;
6294     end;
6295   finally
6296     quit_libJPEG;
6297   end;
6298 end;
6299
6300 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6302 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6303 var
6304   bmp: TBitmap;
6305   jpg: TJPEGImage;
6306   StreamPos: Int64;
6307   Temp: array[0..1]of Byte;
6308 begin
6309   result := false;
6310
6311   // reading first two bytes to test file and set cursor back to begin
6312   StreamPos := aStream.Position;
6313   aStream.Read(Temp[0], 2);
6314   aStream.Position := StreamPos;
6315
6316   // if Bitmap then read file.
6317   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6318     bmp := TBitmap.Create;
6319     try
6320       jpg := TJPEGImage.Create;
6321       try
6322         jpg.LoadFromStream(aStream);
6323         bmp.Assign(jpg);
6324         result := AssignFromBitmap(bmp);
6325       finally
6326         jpg.Free;
6327       end;
6328     finally
6329       bmp.Free;
6330     end;
6331   end;
6332 end;
6333 {$IFEND}
6334 {$ENDIF}
6335
6336 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6337 {$IF DEFINED(GLB_LIB_JPEG)}
6338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6339 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6340 var
6341   jpeg: jpeg_compress_struct;
6342   jpeg_err: jpeg_error_mgr;
6343   Row: Integer;
6344   pTemp, pTemp2: pByte;
6345
6346   procedure CopyRow(pDest, pSource: pByte);
6347   var
6348     X: Integer;
6349   begin
6350     for X := 0 to Width - 1 do begin
6351       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6352       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6353       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6354       Inc(pDest, 3);
6355       Inc(pSource, 3);
6356     end;
6357   end;
6358
6359 begin
6360   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6361     raise EglBitmapUnsupportedFormat.Create(Format);
6362
6363   if not init_libJPEG then
6364     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6365
6366   try
6367     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6368     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6369
6370     // error managment
6371     jpeg.err := jpeg_std_error(@jpeg_err);
6372     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6373     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6374
6375     // compression struct
6376     jpeg_create_compress(@jpeg);
6377
6378     // allocation space for streaming methods
6379     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6380
6381     // seeting up custom functions
6382     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6383       pub.init_destination    := glBitmap_libJPEG_init_destination;
6384       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6385       pub.term_destination    := glBitmap_libJPEG_term_destination;
6386
6387       pub.next_output_byte  := @DestBuffer[1];
6388       pub.free_in_buffer    := Length(DestBuffer);
6389
6390       DestStream := aStream;
6391     end;
6392
6393     // very important state
6394     jpeg.global_state := CSTATE_START;
6395     jpeg.image_width  := Width;
6396     jpeg.image_height := Height;
6397     case Format of
6398       tfAlpha8, tfLuminance8: begin
6399         jpeg.input_components := 1;
6400         jpeg.in_color_space   := JCS_GRAYSCALE;
6401       end;
6402       tfRGB8, tfBGR8: begin
6403         jpeg.input_components := 3;
6404         jpeg.in_color_space   := JCS_RGB;
6405       end;
6406     end;
6407
6408     jpeg_set_defaults(@jpeg);
6409     jpeg_set_quality(@jpeg, 95, true);
6410     jpeg_start_compress(@jpeg, true);
6411     pTemp := Data;
6412
6413     if Format = tfBGR8 then
6414       GetMem(pTemp2, fRowSize)
6415     else
6416       pTemp2 := pTemp;
6417
6418     try
6419       for Row := 0 to jpeg.image_height -1 do begin
6420         // prepare row
6421         if Format = tfBGR8 then
6422           CopyRow(pTemp2, pTemp)
6423         else
6424           pTemp2 := pTemp;
6425
6426         // write row
6427         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6428         inc(pTemp, fRowSize);
6429       end;
6430     finally
6431       // free memory
6432       if Format = tfBGR8 then
6433         FreeMem(pTemp2);
6434     end;
6435     jpeg_finish_compress(@jpeg);
6436     jpeg_destroy_compress(@jpeg);
6437   finally
6438     quit_libJPEG;
6439   end;
6440 end;
6441
6442 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6444 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6445 var
6446   Bmp: TBitmap;
6447   Jpg: TJPEGImage;
6448 begin
6449   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6450     raise EglBitmapUnsupportedFormat.Create(Format);
6451
6452   Bmp := TBitmap.Create;
6453   try
6454     Jpg := TJPEGImage.Create;
6455     try
6456       AssignToBitmap(Bmp);
6457       if (Format in [tfAlpha8, tfLuminance8]) then begin
6458         Jpg.Grayscale   := true;
6459         Jpg.PixelFormat := jf8Bit;
6460       end;
6461       Jpg.Assign(Bmp);
6462       Jpg.SaveToStream(aStream);
6463     finally
6464       FreeAndNil(Jpg);
6465     end;
6466   finally
6467     FreeAndNil(Bmp);
6468   end;
6469 end;
6470 {$IFEND}
6471 {$ENDIF}
6472
6473 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6474 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6475 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6476 const
6477   BMP_MAGIC          = $4D42;
6478
6479   BMP_COMP_RGB       = 0;
6480   BMP_COMP_RLE8      = 1;
6481   BMP_COMP_RLE4      = 2;
6482   BMP_COMP_BITFIELDS = 3;
6483
6484 type
6485   TBMPHeader = packed record
6486     bfType: Word;
6487     bfSize: Cardinal;
6488     bfReserved1: Word;
6489     bfReserved2: Word;
6490     bfOffBits: Cardinal;
6491   end;
6492
6493   TBMPInfo = packed record
6494     biSize: Cardinal;
6495     biWidth: Longint;
6496     biHeight: Longint;
6497     biPlanes: Word;
6498     biBitCount: Word;
6499     biCompression: Cardinal;
6500     biSizeImage: Cardinal;
6501     biXPelsPerMeter: Longint;
6502     biYPelsPerMeter: Longint;
6503     biClrUsed: Cardinal;
6504     biClrImportant: Cardinal;
6505   end;
6506
6507 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6508 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6509
6510   //////////////////////////////////////////////////////////////////////////////////////////////////
6511   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6512   begin
6513     result := tfEmpty;
6514     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6515     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6516
6517     //Read Compression
6518     case aInfo.biCompression of
6519       BMP_COMP_RLE4,
6520       BMP_COMP_RLE8: begin
6521         raise EglBitmap.Create('RLE compression is not supported');
6522       end;
6523       BMP_COMP_BITFIELDS: begin
6524         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6525           aStream.Read(aMask.r, SizeOf(aMask.r));
6526           aStream.Read(aMask.g, SizeOf(aMask.g));
6527           aStream.Read(aMask.b, SizeOf(aMask.b));
6528           aStream.Read(aMask.a, SizeOf(aMask.a));
6529         end else
6530           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6531       end;
6532     end;
6533
6534     //get suitable format
6535     case aInfo.biBitCount of
6536        8: result := tfLuminance8;
6537       16: result := tfBGR5;
6538       24: result := tfBGR8;
6539       32: result := tfBGRA8;
6540     end;
6541   end;
6542
6543   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6544   var
6545     i, c: Integer;
6546     ColorTable: TbmpColorTable;
6547   begin
6548     result := nil;
6549     if (aInfo.biBitCount >= 16) then
6550       exit;
6551     aFormat := tfLuminance8;
6552     c := aInfo.biClrUsed;
6553     if (c = 0) then
6554       c := 1 shl aInfo.biBitCount;
6555     SetLength(ColorTable, c);
6556     for i := 0 to c-1 do begin
6557       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6558       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6559         aFormat := tfRGB8;
6560     end;
6561
6562     result := TbmpColorTableFormat.Create;
6563     result.PixelSize  := aInfo.biBitCount / 8;
6564     result.ColorTable := ColorTable;
6565     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6566   end;
6567
6568   //////////////////////////////////////////////////////////////////////////////////////////////////
6569   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6570     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6571   var
6572     TmpFormat: TglBitmapFormat;
6573     FormatDesc: TFormatDescriptor;
6574   begin
6575     result := nil;
6576     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6577       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6578         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6579         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6580           aFormat := FormatDesc.Format;
6581           exit;
6582         end;
6583       end;
6584
6585       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6586         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6587       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6588         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6589
6590       result := TbmpBitfieldFormat.Create;
6591       result.PixelSize := aInfo.biBitCount / 8;
6592       result.RedMask   := aMask.r;
6593       result.GreenMask := aMask.g;
6594       result.BlueMask  := aMask.b;
6595       result.AlphaMask := aMask.a;
6596     end;
6597   end;
6598
6599 var
6600   //simple types
6601   StartPos: Int64;
6602   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6603   PaddingBuff: Cardinal;
6604   LineBuf, ImageData, TmpData: PByte;
6605   SourceMD, DestMD: Pointer;
6606   BmpFormat: TglBitmapFormat;
6607
6608   //records
6609   Mask: TglBitmapColorRec;
6610   Header: TBMPHeader;
6611   Info: TBMPInfo;
6612
6613   //classes
6614   SpecialFormat: TFormatDescriptor;
6615   FormatDesc: TFormatDescriptor;
6616
6617   //////////////////////////////////////////////////////////////////////////////////////////////////
6618   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6619   var
6620     i: Integer;
6621     Pixel: TglBitmapPixelData;
6622   begin
6623     aStream.Read(aLineBuf^, rbLineSize);
6624     SpecialFormat.PreparePixel(Pixel);
6625     for i := 0 to Info.biWidth-1 do begin
6626       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6627       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6628       FormatDesc.Map(Pixel, aData, DestMD);
6629     end;
6630   end;
6631
6632 begin
6633   result        := false;
6634   BmpFormat     := tfEmpty;
6635   SpecialFormat := nil;
6636   LineBuf       := nil;
6637   SourceMD      := nil;
6638   DestMD        := nil;
6639
6640   // Header
6641   StartPos := aStream.Position;
6642   aStream.Read(Header{%H-}, SizeOf(Header));
6643
6644   if Header.bfType = BMP_MAGIC then begin
6645     try try
6646       BmpFormat        := ReadInfo(Info, Mask);
6647       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6648       if not Assigned(SpecialFormat) then
6649         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6650       aStream.Position := StartPos + Header.bfOffBits;
6651
6652       if (BmpFormat <> tfEmpty) then begin
6653         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6654         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6655         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6656         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6657
6658         //get Memory
6659         DestMD    := FormatDesc.CreateMappingData;
6660         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6661         GetMem(ImageData, ImageSize);
6662         if Assigned(SpecialFormat) then begin
6663           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6664           SourceMD := SpecialFormat.CreateMappingData;
6665         end;
6666
6667         //read Data
6668         try try
6669           FillChar(ImageData^, ImageSize, $FF);
6670           TmpData := ImageData;
6671           if (Info.biHeight > 0) then
6672             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6673           for i := 0 to Abs(Info.biHeight)-1 do begin
6674             if Assigned(SpecialFormat) then
6675               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6676             else
6677               aStream.Read(TmpData^, wbLineSize);   //else only read data
6678             if (Info.biHeight > 0) then
6679               dec(TmpData, wbLineSize)
6680             else
6681               inc(TmpData, wbLineSize);
6682             aStream.Read(PaddingBuff{%H-}, Padding);
6683           end;
6684           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6685           result := true;
6686         finally
6687           if Assigned(LineBuf) then
6688             FreeMem(LineBuf);
6689           if Assigned(SourceMD) then
6690             SpecialFormat.FreeMappingData(SourceMD);
6691           FormatDesc.FreeMappingData(DestMD);
6692         end;
6693         except
6694           if Assigned(ImageData) then
6695             FreeMem(ImageData);
6696           raise;
6697         end;
6698       end else
6699         raise EglBitmap.Create('LoadBMP - No suitable format found');
6700     except
6701       aStream.Position := StartPos;
6702       raise;
6703     end;
6704     finally
6705       FreeAndNil(SpecialFormat);
6706     end;
6707   end
6708     else aStream.Position := StartPos;
6709 end;
6710
6711 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6712 procedure TglBitmap.SaveBMP(const aStream: TStream);
6713 var
6714   Header: TBMPHeader;
6715   Info: TBMPInfo;
6716   Converter: TbmpColorTableFormat;
6717   FormatDesc: TFormatDescriptor;
6718   SourceFD, DestFD: Pointer;
6719   pData, srcData, dstData, ConvertBuffer: pByte;
6720
6721   Pixel: TglBitmapPixelData;
6722   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6723   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6724
6725   PaddingBuff: Cardinal;
6726
6727   function GetLineWidth : Integer;
6728   begin
6729     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6730   end;
6731
6732 begin
6733   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6734     raise EglBitmapUnsupportedFormat.Create(Format);
6735
6736   Converter  := nil;
6737   FormatDesc := TFormatDescriptor.Get(Format);
6738   ImageSize  := FormatDesc.GetSize(Dimension);
6739
6740   FillChar(Header{%H-}, SizeOf(Header), 0);
6741   Header.bfType      := BMP_MAGIC;
6742   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6743   Header.bfReserved1 := 0;
6744   Header.bfReserved2 := 0;
6745   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6746
6747   FillChar(Info{%H-}, SizeOf(Info), 0);
6748   Info.biSize        := SizeOf(Info);
6749   Info.biWidth       := Width;
6750   Info.biHeight      := Height;
6751   Info.biPlanes      := 1;
6752   Info.biCompression := BMP_COMP_RGB;
6753   Info.biSizeImage   := ImageSize;
6754
6755   try
6756     case Format of
6757       tfLuminance4: begin
6758         Info.biBitCount  := 4;
6759         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6760         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6761         Converter           := TbmpColorTableFormat.Create;
6762         Converter.PixelSize := 0.5;
6763         Converter.Format    := Format;
6764         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);
6765         Converter.CreateColorTable;
6766       end;
6767
6768       tfR3G3B2, tfLuminance8: begin
6769         Info.biBitCount  :=  8;
6770         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6771         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6772         Converter           := TbmpColorTableFormat.Create;
6773         Converter.PixelSize := 1;
6774         Converter.Format    := Format;
6775         if (Format = tfR3G3B2) then begin
6776           Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6777           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6778         end else
6779           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6780         Converter.CreateColorTable;
6781       end;
6782
6783       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6784       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6785         Info.biBitCount    := 16;
6786         Info.biCompression := BMP_COMP_BITFIELDS;
6787       end;
6788
6789       tfBGR8, tfRGB8: begin
6790         Info.biBitCount := 24;
6791       end;
6792
6793       tfRGB10, tfRGB10A2, tfRGBA8,
6794       tfBGR10, tfBGR10A2, tfBGRA8: begin
6795         Info.biBitCount    := 32;
6796         Info.biCompression := BMP_COMP_BITFIELDS;
6797       end;
6798     else
6799       raise EglBitmapUnsupportedFormat.Create(Format);
6800     end;
6801     Info.biXPelsPerMeter := 2835;
6802     Info.biYPelsPerMeter := 2835;
6803
6804     // prepare bitmasks
6805     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6806       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
6807       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6808
6809       RedMask    := FormatDesc.RedMask;
6810       GreenMask  := FormatDesc.GreenMask;
6811       BlueMask   := FormatDesc.BlueMask;
6812       AlphaMask  := FormatDesc.AlphaMask;
6813     end;
6814
6815     // headers
6816     aStream.Write(Header, SizeOf(Header));
6817     aStream.Write(Info, SizeOf(Info));
6818
6819     // colortable
6820     if Assigned(Converter) then
6821       aStream.Write(Converter.ColorTable[0].b,
6822         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6823
6824     // bitmasks
6825     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6826       aStream.Write(RedMask,   SizeOf(Cardinal));
6827       aStream.Write(GreenMask, SizeOf(Cardinal));
6828       aStream.Write(BlueMask,  SizeOf(Cardinal));
6829       aStream.Write(AlphaMask, SizeOf(Cardinal));
6830     end;
6831
6832     // image data
6833     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
6834     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
6835     Padding     := GetLineWidth - wbLineSize;
6836     PaddingBuff := 0;
6837
6838     pData := Data;
6839     inc(pData, (Height-1) * rbLineSize);
6840
6841     // prepare row buffer. But only for RGB because RGBA supports color masks
6842     // so it's possible to change color within the image.
6843     if Assigned(Converter) then begin
6844       FormatDesc.PreparePixel(Pixel);
6845       GetMem(ConvertBuffer, wbLineSize);
6846       SourceFD := FormatDesc.CreateMappingData;
6847       DestFD   := Converter.CreateMappingData;
6848     end else
6849       ConvertBuffer := nil;
6850
6851     try
6852       for LineIdx := 0 to Height - 1 do begin
6853         // preparing row
6854         if Assigned(Converter) then begin
6855           srcData := pData;
6856           dstData := ConvertBuffer;
6857           for PixelIdx := 0 to Info.biWidth-1 do begin
6858             FormatDesc.Unmap(srcData, Pixel, SourceFD);
6859             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
6860             Converter.Map(Pixel, dstData, DestFD);
6861           end;
6862           aStream.Write(ConvertBuffer^, wbLineSize);
6863         end else begin
6864           aStream.Write(pData^, rbLineSize);
6865         end;
6866         dec(pData, rbLineSize);
6867         if (Padding > 0) then
6868           aStream.Write(PaddingBuff, Padding);
6869       end;
6870     finally
6871       // destroy row buffer
6872       if Assigned(ConvertBuffer) then begin
6873         FormatDesc.FreeMappingData(SourceFD);
6874         Converter.FreeMappingData(DestFD);
6875         FreeMem(ConvertBuffer);
6876       end;
6877     end;
6878   finally
6879     if Assigned(Converter) then
6880       Converter.Free;
6881   end;
6882 end;
6883
6884 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6885 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6886 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6887 type
6888   TTGAHeader = packed record
6889     ImageID: Byte;
6890     ColorMapType: Byte;
6891     ImageType: Byte;
6892     //ColorMapSpec: Array[0..4] of Byte;
6893     ColorMapStart: Word;
6894     ColorMapLength: Word;
6895     ColorMapEntrySize: Byte;
6896     OrigX: Word;
6897     OrigY: Word;
6898     Width: Word;
6899     Height: Word;
6900     Bpp: Byte;
6901     ImageDesc: Byte;
6902   end;
6903
6904 const
6905   TGA_UNCOMPRESSED_RGB  =  2;
6906   TGA_UNCOMPRESSED_GRAY =  3;
6907   TGA_COMPRESSED_RGB    = 10;
6908   TGA_COMPRESSED_GRAY   = 11;
6909
6910   TGA_NONE_COLOR_TABLE  = 0;
6911
6912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6913 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6914 var
6915   Header: TTGAHeader;
6916   ImageData: System.PByte;
6917   StartPosition: Int64;
6918   PixelSize, LineSize: Integer;
6919   tgaFormat: TglBitmapFormat;
6920   FormatDesc: TFormatDescriptor;
6921   Counter: packed record
6922     X, Y: packed record
6923       low, high, dir: Integer;
6924     end;
6925   end;
6926
6927 const
6928   CACHE_SIZE = $4000;
6929
6930   ////////////////////////////////////////////////////////////////////////////////////////
6931   procedure ReadUncompressed;
6932   var
6933     i, j: Integer;
6934     buf, tmp1, tmp2: System.PByte;
6935   begin
6936     buf := nil;
6937     if (Counter.X.dir < 0) then
6938       GetMem(buf, LineSize);
6939     try
6940       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
6941         tmp1 := ImageData;
6942         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
6943         if (Counter.X.dir < 0) then begin               //flip X
6944           aStream.Read(buf^, LineSize);
6945           tmp2 := buf;
6946           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
6947           for i := 0 to Header.Width-1 do begin         //for all pixels in line
6948             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
6949               tmp1^ := tmp2^;
6950               inc(tmp1);
6951               inc(tmp2);
6952             end;
6953             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
6954           end;
6955         end else
6956           aStream.Read(tmp1^, LineSize);
6957         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
6958       end;
6959     finally
6960       if Assigned(buf) then
6961         FreeMem(buf);
6962     end;
6963   end;
6964
6965   ////////////////////////////////////////////////////////////////////////////////////////
6966   procedure ReadCompressed;
6967
6968     /////////////////////////////////////////////////////////////////
6969     var
6970       TmpData: System.PByte;
6971       LinePixelsRead: Integer;
6972     procedure CheckLine;
6973     begin
6974       if (LinePixelsRead >= Header.Width) then begin
6975         LinePixelsRead := 0;
6976         inc(Counter.Y.low, Counter.Y.dir);                //next line index
6977         TmpData := ImageData;
6978         inc(TmpData, Counter.Y.low * LineSize);           //set line
6979         if (Counter.X.dir < 0) then                       //if x flipped then
6980           inc(TmpData, LineSize - PixelSize);             //set last pixel
6981       end;
6982     end;
6983
6984     /////////////////////////////////////////////////////////////////
6985     var
6986       Cache: PByte;
6987       CacheSize, CachePos: Integer;
6988     procedure CachedRead(out Buffer; Count: Integer);
6989     var
6990       BytesRead: Integer;
6991     begin
6992       if (CachePos + Count > CacheSize) then begin
6993         //if buffer overflow save non read bytes
6994         BytesRead := 0;
6995         if (CacheSize - CachePos > 0) then begin
6996           BytesRead := CacheSize - CachePos;
6997           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
6998           inc(CachePos, BytesRead);
6999         end;
7000
7001         //load cache from file
7002         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7003         aStream.Read(Cache^, CacheSize);
7004         CachePos := 0;
7005
7006         //read rest of requested bytes
7007         if (Count - BytesRead > 0) then begin
7008           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7009           inc(CachePos, Count - BytesRead);
7010         end;
7011       end else begin
7012         //if no buffer overflow just read the data
7013         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7014         inc(CachePos, Count);
7015       end;
7016     end;
7017
7018     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7019     begin
7020       case PixelSize of
7021         1: begin
7022           aBuffer^ := aData^;
7023           inc(aBuffer, Counter.X.dir);
7024         end;
7025         2: begin
7026           PWord(aBuffer)^ := PWord(aData)^;
7027           inc(aBuffer, 2 * Counter.X.dir);
7028         end;
7029         3: begin
7030           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7031           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7032           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7033           inc(aBuffer, 3 * Counter.X.dir);
7034         end;
7035         4: begin
7036           PCardinal(aBuffer)^ := PCardinal(aData)^;
7037           inc(aBuffer, 4 * Counter.X.dir);
7038         end;
7039       end;
7040     end;
7041
7042   var
7043     TotalPixelsToRead, TotalPixelsRead: Integer;
7044     Temp: Byte;
7045     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7046     PixelRepeat: Boolean;
7047     PixelsToRead, PixelCount: Integer;
7048   begin
7049     CacheSize := 0;
7050     CachePos  := 0;
7051
7052     TotalPixelsToRead := Header.Width * Header.Height;
7053     TotalPixelsRead   := 0;
7054     LinePixelsRead    := 0;
7055
7056     GetMem(Cache, CACHE_SIZE);
7057     try
7058       TmpData := ImageData;
7059       inc(TmpData, Counter.Y.low * LineSize);           //set line
7060       if (Counter.X.dir < 0) then                       //if x flipped then
7061         inc(TmpData, LineSize - PixelSize);             //set last pixel
7062
7063       repeat
7064         //read CommandByte
7065         CachedRead(Temp, 1);
7066         PixelRepeat  := (Temp and $80) > 0;
7067         PixelsToRead := (Temp and $7F) + 1;
7068         inc(TotalPixelsRead, PixelsToRead);
7069
7070         if PixelRepeat then
7071           CachedRead(buf[0], PixelSize);
7072         while (PixelsToRead > 0) do begin
7073           CheckLine;
7074           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7075           while (PixelCount > 0) do begin
7076             if not PixelRepeat then
7077               CachedRead(buf[0], PixelSize);
7078             PixelToBuffer(@buf[0], TmpData);
7079             inc(LinePixelsRead);
7080             dec(PixelsToRead);
7081             dec(PixelCount);
7082           end;
7083         end;
7084       until (TotalPixelsRead >= TotalPixelsToRead);
7085     finally
7086       FreeMem(Cache);
7087     end;
7088   end;
7089
7090   function IsGrayFormat: Boolean;
7091   begin
7092     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7093   end;
7094
7095 begin
7096   result := false;
7097
7098   // reading header to test file and set cursor back to begin
7099   StartPosition := aStream.Position;
7100   aStream.Read(Header{%H-}, SizeOf(Header));
7101
7102   // no colormapped files
7103   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7104     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7105   begin
7106     try
7107       if Header.ImageID <> 0 then       // skip image ID
7108         aStream.Position := aStream.Position + Header.ImageID;
7109
7110       tgaFormat := tfEmpty;
7111       case Header.Bpp of
7112          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7113                0: tgaFormat := tfLuminance8;
7114                8: tgaFormat := tfAlpha8;
7115             end;
7116
7117         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7118                0: tgaFormat := tfLuminance16;
7119                8: tgaFormat := tfLuminance8Alpha8;
7120             end else case (Header.ImageDesc and $F) of
7121                0: tgaFormat := tfBGR5;
7122                1: tgaFormat := tfBGR5A1;
7123                4: tgaFormat := tfBGRA4;
7124             end;
7125
7126         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7127                0: tgaFormat := tfBGR8;
7128             end;
7129
7130         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7131                2: tgaFormat := tfBGR10A2;
7132                8: tgaFormat := tfBGRA8;
7133             end;
7134       end;
7135
7136       if (tgaFormat = tfEmpty) then
7137         raise EglBitmap.Create('LoadTga - unsupported format');
7138
7139       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7140       PixelSize  := FormatDesc.GetSize(1, 1);
7141       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7142
7143       GetMem(ImageData, LineSize * Header.Height);
7144       try
7145         //column direction
7146         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7147           Counter.X.low  := Header.Height-1;;
7148           Counter.X.high := 0;
7149           Counter.X.dir  := -1;
7150         end else begin
7151           Counter.X.low  := 0;
7152           Counter.X.high := Header.Height-1;
7153           Counter.X.dir  := 1;
7154         end;
7155
7156         // Row direction
7157         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7158           Counter.Y.low  := 0;
7159           Counter.Y.high := Header.Height-1;
7160           Counter.Y.dir  := 1;
7161         end else begin
7162           Counter.Y.low  := Header.Height-1;;
7163           Counter.Y.high := 0;
7164           Counter.Y.dir  := -1;
7165         end;
7166
7167         // Read Image
7168         case Header.ImageType of
7169           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7170             ReadUncompressed;
7171           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7172             ReadCompressed;
7173         end;
7174
7175         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7176         result := true;
7177       except
7178         if Assigned(ImageData) then
7179           FreeMem(ImageData);
7180         raise;
7181       end;
7182     finally
7183       aStream.Position := StartPosition;
7184     end;
7185   end
7186     else aStream.Position := StartPosition;
7187 end;
7188
7189 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7190 procedure TglBitmap.SaveTGA(const aStream: TStream);
7191 var
7192   Header: TTGAHeader;
7193   LineSize, Size, x, y: Integer;
7194   Pixel: TglBitmapPixelData;
7195   LineBuf, SourceData, DestData: PByte;
7196   SourceMD, DestMD: Pointer;
7197   FormatDesc: TFormatDescriptor;
7198   Converter: TFormatDescriptor;
7199 begin
7200   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7201     raise EglBitmapUnsupportedFormat.Create(Format);
7202
7203   //prepare header
7204   FillChar(Header{%H-}, SizeOf(Header), 0);
7205
7206   //set ImageType
7207   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7208                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7209     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7210   else
7211     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7212
7213   //set BitsPerPixel
7214   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7215     Header.Bpp := 8
7216   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7217                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7218     Header.Bpp := 16
7219   else if (Format in [tfBGR8, tfRGB8]) then
7220     Header.Bpp := 24
7221   else
7222     Header.Bpp := 32;
7223
7224   //set AlphaBitCount
7225   case Format of
7226     tfRGB5A1, tfBGR5A1:
7227       Header.ImageDesc := 1 and $F;
7228     tfRGB10A2, tfBGR10A2:
7229       Header.ImageDesc := 2 and $F;
7230     tfRGBA4, tfBGRA4:
7231       Header.ImageDesc := 4 and $F;
7232     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7233       Header.ImageDesc := 8 and $F;
7234   end;
7235
7236   Header.Width     := Width;
7237   Header.Height    := Height;
7238   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7239   aStream.Write(Header, SizeOf(Header));
7240
7241   // convert RGB(A) to BGR(A)
7242   Converter  := nil;
7243   FormatDesc := TFormatDescriptor.Get(Format);
7244   Size       := FormatDesc.GetSize(Dimension);
7245   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7246     if (FormatDesc.RGBInverted = tfEmpty) then
7247       raise EglBitmap.Create('inverted RGB format is empty');
7248     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7249     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7250        (Converter.PixelSize <> FormatDesc.PixelSize) then
7251       raise EglBitmap.Create('invalid inverted RGB format');
7252   end;
7253
7254   if Assigned(Converter) then begin
7255     LineSize := FormatDesc.GetSize(Width, 1);
7256     GetMem(LineBuf, LineSize);
7257     SourceMD := FormatDesc.CreateMappingData;
7258     DestMD   := Converter.CreateMappingData;
7259     try
7260       SourceData := Data;
7261       for y := 0 to Height-1 do begin
7262         DestData := LineBuf;
7263         for x := 0 to Width-1 do begin
7264           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7265           Converter.Map(Pixel, DestData, DestMD);
7266         end;
7267         aStream.Write(LineBuf^, LineSize);
7268       end;
7269     finally
7270       FreeMem(LineBuf);
7271       FormatDesc.FreeMappingData(SourceMD);
7272       FormatDesc.FreeMappingData(DestMD);
7273     end;
7274   end else
7275     aStream.Write(Data^, Size);
7276 end;
7277
7278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7279 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7280 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7281 const
7282   DDS_MAGIC: Cardinal         = $20534444;
7283
7284   // DDS_header.dwFlags
7285   DDSD_CAPS                   = $00000001;
7286   DDSD_HEIGHT                 = $00000002;
7287   DDSD_WIDTH                  = $00000004;
7288   DDSD_PIXELFORMAT            = $00001000;
7289
7290   // DDS_header.sPixelFormat.dwFlags
7291   DDPF_ALPHAPIXELS            = $00000001;
7292   DDPF_ALPHA                  = $00000002;
7293   DDPF_FOURCC                 = $00000004;
7294   DDPF_RGB                    = $00000040;
7295   DDPF_LUMINANCE              = $00020000;
7296
7297   // DDS_header.sCaps.dwCaps1
7298   DDSCAPS_TEXTURE             = $00001000;
7299
7300   // DDS_header.sCaps.dwCaps2
7301   DDSCAPS2_CUBEMAP            = $00000200;
7302
7303   D3DFMT_DXT1                 = $31545844;
7304   D3DFMT_DXT3                 = $33545844;
7305   D3DFMT_DXT5                 = $35545844;
7306
7307 type
7308   TDDSPixelFormat = packed record
7309     dwSize: Cardinal;
7310     dwFlags: Cardinal;
7311     dwFourCC: Cardinal;
7312     dwRGBBitCount: Cardinal;
7313     dwRBitMask: Cardinal;
7314     dwGBitMask: Cardinal;
7315     dwBBitMask: Cardinal;
7316     dwABitMask: Cardinal;
7317   end;
7318
7319   TDDSCaps = packed record
7320     dwCaps1: Cardinal;
7321     dwCaps2: Cardinal;
7322     dwDDSX: Cardinal;
7323     dwReserved: Cardinal;
7324   end;
7325
7326   TDDSHeader = packed record
7327     dwSize: Cardinal;
7328     dwFlags: Cardinal;
7329     dwHeight: Cardinal;
7330     dwWidth: Cardinal;
7331     dwPitchOrLinearSize: Cardinal;
7332     dwDepth: Cardinal;
7333     dwMipMapCount: Cardinal;
7334     dwReserved: array[0..10] of Cardinal;
7335     PixelFormat: TDDSPixelFormat;
7336     Caps: TDDSCaps;
7337     dwReserved2: Cardinal;
7338   end;
7339
7340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7341 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7342 var
7343   Header: TDDSHeader;
7344   Converter: TbmpBitfieldFormat;
7345
7346   function GetDDSFormat: TglBitmapFormat;
7347   var
7348     fd: TFormatDescriptor;
7349     i: Integer;
7350     Range: TglBitmapColorRec;
7351     match: Boolean;
7352   begin
7353     result := tfEmpty;
7354     with Header.PixelFormat do begin
7355       // Compresses
7356       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7357         case Header.PixelFormat.dwFourCC of
7358           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7359           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7360           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7361         end;
7362       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7363
7364         //find matching format
7365         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7366           fd := TFormatDescriptor.Get(result);
7367           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7368              (8 * fd.PixelSize = dwRGBBitCount) then
7369             exit;
7370         end;
7371
7372         //find format with same Range
7373         Range.r := dwRBitMask;
7374         Range.g := dwGBitMask;
7375         Range.b := dwBBitMask;
7376         Range.a := dwABitMask;
7377         for i := 0 to 3 do begin
7378           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7379             Range.arr[i] := Range.arr[i] shr 1;
7380         end;
7381         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7382           fd := TFormatDescriptor.Get(result);
7383           match := true;
7384           for i := 0 to 3 do
7385             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7386               match := false;
7387               break;
7388             end;
7389           if match then
7390             break;
7391         end;
7392
7393         //no format with same range found -> use default
7394         if (result = tfEmpty) then begin
7395           if (dwABitMask > 0) then
7396             result := tfBGRA8
7397           else
7398             result := tfBGR8;
7399         end;
7400
7401         Converter := TbmpBitfieldFormat.Create;
7402         Converter.RedMask   := dwRBitMask;
7403         Converter.GreenMask := dwGBitMask;
7404         Converter.BlueMask  := dwBBitMask;
7405         Converter.AlphaMask := dwABitMask;
7406         Converter.PixelSize := dwRGBBitCount / 8;
7407       end;
7408     end;
7409   end;
7410
7411 var
7412   StreamPos: Int64;
7413   x, y, LineSize, RowSize, Magic: Cardinal;
7414   NewImage, TmpData, RowData, SrcData: System.PByte;
7415   SourceMD, DestMD: Pointer;
7416   Pixel: TglBitmapPixelData;
7417   ddsFormat: TglBitmapFormat;
7418   FormatDesc: TFormatDescriptor;
7419
7420 begin
7421   result    := false;
7422   Converter := nil;
7423   StreamPos := aStream.Position;
7424
7425   // Magic
7426   aStream.Read(Magic{%H-}, sizeof(Magic));
7427   if (Magic <> DDS_MAGIC) then begin
7428     aStream.Position := StreamPos;
7429     exit;
7430   end;
7431
7432   //Header
7433   aStream.Read(Header{%H-}, sizeof(Header));
7434   if (Header.dwSize <> SizeOf(Header)) or
7435      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7436         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7437   begin
7438     aStream.Position := StreamPos;
7439     exit;
7440   end;
7441
7442   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7443     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7444
7445   ddsFormat := GetDDSFormat;
7446   try
7447     if (ddsFormat = tfEmpty) then
7448       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7449
7450     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7451     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7452     GetMem(NewImage, Header.dwHeight * LineSize);
7453     try
7454       TmpData := NewImage;
7455
7456       //Converter needed
7457       if Assigned(Converter) then begin
7458         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7459         GetMem(RowData, RowSize);
7460         SourceMD := Converter.CreateMappingData;
7461         DestMD   := FormatDesc.CreateMappingData;
7462         try
7463           for y := 0 to Header.dwHeight-1 do begin
7464             TmpData := NewImage;
7465             inc(TmpData, y * LineSize);
7466             SrcData := RowData;
7467             aStream.Read(SrcData^, RowSize);
7468             for x := 0 to Header.dwWidth-1 do begin
7469               Converter.Unmap(SrcData, Pixel, SourceMD);
7470               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7471               FormatDesc.Map(Pixel, TmpData, DestMD);
7472             end;
7473           end;
7474         finally
7475           Converter.FreeMappingData(SourceMD);
7476           FormatDesc.FreeMappingData(DestMD);
7477           FreeMem(RowData);
7478         end;
7479       end else
7480
7481       // Compressed
7482       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7483         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7484         for Y := 0 to Header.dwHeight-1 do begin
7485           aStream.Read(TmpData^, RowSize);
7486           Inc(TmpData, LineSize);
7487         end;
7488       end else
7489
7490       // Uncompressed
7491       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7492         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7493         for Y := 0 to Header.dwHeight-1 do begin
7494           aStream.Read(TmpData^, RowSize);
7495           Inc(TmpData, LineSize);
7496         end;
7497       end else
7498         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7499
7500       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7501       result := true;
7502     except
7503       if Assigned(NewImage) then
7504         FreeMem(NewImage);
7505       raise;
7506     end;
7507   finally
7508     FreeAndNil(Converter);
7509   end;
7510 end;
7511
7512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7513 procedure TglBitmap.SaveDDS(const aStream: TStream);
7514 var
7515   Header: TDDSHeader;
7516   FormatDesc: TFormatDescriptor;
7517 begin
7518   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7519     raise EglBitmapUnsupportedFormat.Create(Format);
7520
7521   FormatDesc := TFormatDescriptor.Get(Format);
7522
7523   // Generell
7524   FillChar(Header{%H-}, SizeOf(Header), 0);
7525   Header.dwSize  := SizeOf(Header);
7526   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7527
7528   Header.dwWidth  := Max(1, Width);
7529   Header.dwHeight := Max(1, Height);
7530
7531   // Caps
7532   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7533
7534   // Pixelformat
7535   Header.PixelFormat.dwSize := sizeof(Header);
7536   if (FormatDesc.IsCompressed) then begin
7537     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7538     case Format of
7539       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7540       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7541       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7542     end;
7543   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7544     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7545     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7546     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7547   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7548     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7549     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7550     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7551     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7552   end else begin
7553     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7554     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7555     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7556     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7557     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7558     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7559   end;
7560
7561   if (FormatDesc.HasAlpha) then
7562     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7563
7564   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7565   aStream.Write(Header, SizeOf(Header));
7566   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7567 end;
7568
7569 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7570 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7572 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7573   const aWidth: Integer; const aHeight: Integer);
7574 var
7575   pTemp: pByte;
7576   Size: Integer;
7577 begin
7578   if (aHeight > 1) then begin
7579     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7580     GetMem(pTemp, Size);
7581     try
7582       Move(aData^, pTemp^, Size);
7583       FreeMem(aData);
7584       aData := nil;
7585     except
7586       FreeMem(pTemp);
7587       raise;
7588     end;
7589   end else
7590     pTemp := aData;
7591   inherited SetDataPointer(pTemp, aFormat, aWidth);
7592 end;
7593
7594 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7595 function TglBitmap1D.FlipHorz: Boolean;
7596 var
7597   Col: Integer;
7598   pTempDest, pDest, pSource: PByte;
7599 begin
7600   result := inherited FlipHorz;
7601   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7602     pSource := Data;
7603     GetMem(pDest, fRowSize);
7604     try
7605       pTempDest := pDest;
7606       Inc(pTempDest, fRowSize);
7607       for Col := 0 to Width-1 do begin
7608         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7609         Move(pSource^, pTempDest^, fPixelSize);
7610         Inc(pSource, fPixelSize);
7611       end;
7612       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7613       result := true;
7614     except
7615       if Assigned(pDest) then
7616         FreeMem(pDest);
7617       raise;
7618     end;
7619   end;
7620 end;
7621
7622 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7623 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7624 var
7625   FormatDesc: TFormatDescriptor;
7626 begin
7627   // Upload data
7628   FormatDesc := TFormatDescriptor.Get(Format);
7629   if FormatDesc.IsCompressed then
7630     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7631   else if aBuildWithGlu then
7632     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7633   else
7634     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7635
7636   // Free Data
7637   if (FreeDataAfterGenTexture) then
7638     FreeData;
7639 end;
7640
7641 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7642 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7643 var
7644   BuildWithGlu, TexRec: Boolean;
7645   TexSize: Integer;
7646 begin
7647   if Assigned(Data) then begin
7648     // Check Texture Size
7649     if (aTestTextureSize) then begin
7650       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7651
7652       if (Width > TexSize) then
7653         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7654
7655       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7656                 (Target = GL_TEXTURE_RECTANGLE);
7657       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7658         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7659     end;
7660
7661     CreateId;
7662     SetupParameters(BuildWithGlu);
7663     UploadData(BuildWithGlu);
7664     glAreTexturesResident(1, @fID, @fIsResident);
7665   end;
7666 end;
7667
7668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7669 procedure TglBitmap1D.AfterConstruction;
7670 begin
7671   inherited;
7672   Target := GL_TEXTURE_1D;
7673 end;
7674
7675 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7676 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7678 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7679 begin
7680   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7681     result := fLines[aIndex]
7682   else
7683     result := nil;
7684 end;
7685
7686 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7687 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7688   const aWidth: Integer; const aHeight: Integer);
7689 var
7690   Idx, LineWidth: Integer;
7691 begin
7692   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7693
7694   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7695     // Assigning Data
7696     if Assigned(Data) then begin
7697       SetLength(fLines, GetHeight);
7698       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7699
7700       for Idx := 0 to GetHeight-1 do begin
7701         fLines[Idx] := Data;
7702         Inc(fLines[Idx], Idx * LineWidth);
7703       end;
7704     end
7705       else SetLength(fLines, 0);
7706   end else begin
7707     SetLength(fLines, 0);
7708   end;
7709 end;
7710
7711 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7712 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7713 var
7714   FormatDesc: TFormatDescriptor;
7715 begin
7716   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7717
7718   FormatDesc := TFormatDescriptor.Get(Format);
7719   if FormatDesc.IsCompressed then begin
7720     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7721   end else if aBuildWithGlu then begin
7722     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7723       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7724   end else begin
7725     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7726       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7727   end;
7728
7729   // Freigeben
7730   if (FreeDataAfterGenTexture) then
7731     FreeData;
7732 end;
7733
7734 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7735 procedure TglBitmap2D.AfterConstruction;
7736 begin
7737   inherited;
7738   Target := GL_TEXTURE_2D;
7739 end;
7740
7741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7742 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7743 var
7744   Temp: pByte;
7745   Size, w, h: Integer;
7746   FormatDesc: TFormatDescriptor;
7747 begin
7748   FormatDesc := TFormatDescriptor.Get(aFormat);
7749   if FormatDesc.IsCompressed then
7750     raise EglBitmapUnsupportedFormat.Create(aFormat);
7751
7752   w    := aRight  - aLeft;
7753   h    := aBottom - aTop;
7754   Size := FormatDesc.GetSize(w, h);
7755   GetMem(Temp, Size);
7756   try
7757     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7758     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7759     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
7760     FlipVert;
7761   except
7762     if Assigned(Temp) then
7763       FreeMem(Temp);
7764     raise;
7765   end;
7766 end;
7767
7768 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7769 procedure TglBitmap2D.GetDataFromTexture;
7770 var
7771   Temp: PByte;
7772   TempWidth, TempHeight: Integer;
7773   TempIntFormat: Cardinal;
7774   IntFormat, f: TglBitmapFormat;
7775   FormatDesc: TFormatDescriptor;
7776 begin
7777   Bind;
7778
7779   // Request Data
7780   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7781   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7782   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7783
7784   IntFormat := tfEmpty;
7785   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7786     FormatDesc := TFormatDescriptor.Get(f);
7787     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7788       IntFormat := FormatDesc.Format;
7789       break;
7790     end;
7791   end;
7792
7793   // Getting data from OpenGL
7794   FormatDesc := TFormatDescriptor.Get(IntFormat);
7795   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7796   try
7797     if FormatDesc.IsCompressed then
7798       glGetCompressedTexImage(Target, 0, Temp)
7799     else
7800      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7801     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
7802   except
7803     if Assigned(Temp) then
7804       FreeMem(Temp);
7805     raise;
7806   end;
7807 end;
7808
7809 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7810 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7811 var
7812   BuildWithGlu, PotTex, TexRec: Boolean;
7813   TexSize: Integer;
7814 begin
7815   if Assigned(Data) then begin
7816     // Check Texture Size
7817     if (aTestTextureSize) then begin
7818       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7819
7820       if ((Height > TexSize) or (Width > TexSize)) then
7821         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7822
7823       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7824       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
7825       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7826         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7827     end;
7828
7829     CreateId;
7830     SetupParameters(BuildWithGlu);
7831     UploadData(Target, BuildWithGlu);
7832     glAreTexturesResident(1, @fID, @fIsResident);
7833   end;
7834 end;
7835
7836 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7837 function TglBitmap2D.FlipHorz: Boolean;
7838 var
7839   Col, Row: Integer;
7840   TempDestData, DestData, SourceData: PByte;
7841   ImgSize: Integer;
7842 begin
7843   result := inherited FlipHorz;
7844   if Assigned(Data) then begin
7845     SourceData := Data;
7846     ImgSize := Height * fRowSize;
7847     GetMem(DestData, ImgSize);
7848     try
7849       TempDestData := DestData;
7850       Dec(TempDestData, fRowSize + fPixelSize);
7851       for Row := 0 to Height -1 do begin
7852         Inc(TempDestData, fRowSize * 2);
7853         for Col := 0 to Width -1 do begin
7854           Move(SourceData^, TempDestData^, fPixelSize);
7855           Inc(SourceData, fPixelSize);
7856           Dec(TempDestData, fPixelSize);
7857         end;
7858       end;
7859       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
7860       result := true;
7861     except
7862       if Assigned(DestData) then
7863         FreeMem(DestData);
7864       raise;
7865     end;
7866   end;
7867 end;
7868
7869 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7870 function TglBitmap2D.FlipVert: Boolean;
7871 var
7872   Row: Integer;
7873   TempDestData, DestData, SourceData: PByte;
7874 begin
7875   result := inherited FlipVert;
7876   if Assigned(Data) then begin
7877     SourceData := Data;
7878     GetMem(DestData, Height * fRowSize);
7879     try
7880       TempDestData := DestData;
7881       Inc(TempDestData, Width * (Height -1) * fPixelSize);
7882       for Row := 0 to Height -1 do begin
7883         Move(SourceData^, TempDestData^, fRowSize);
7884         Dec(TempDestData, fRowSize);
7885         Inc(SourceData, fRowSize);
7886       end;
7887       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
7888       result := true;
7889     except
7890       if Assigned(DestData) then
7891         FreeMem(DestData);
7892       raise;
7893     end;
7894   end;
7895 end;
7896
7897 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7898 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7899 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7900 type
7901   TMatrixItem = record
7902     X, Y: Integer;
7903     W: Single;
7904   end;
7905
7906   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7907   TglBitmapToNormalMapRec = Record
7908     Scale: Single;
7909     Heights: array of Single;
7910     MatrixU : array of TMatrixItem;
7911     MatrixV : array of TMatrixItem;
7912   end;
7913
7914 const
7915   ONE_OVER_255 = 1 / 255;
7916
7917   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7918 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7919 var
7920   Val: Single;
7921 begin
7922   with FuncRec do begin
7923     Val :=
7924       Source.Data.r * LUMINANCE_WEIGHT_R +
7925       Source.Data.g * LUMINANCE_WEIGHT_G +
7926       Source.Data.b * LUMINANCE_WEIGHT_B;
7927     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7928   end;
7929 end;
7930
7931 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7932 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7933 begin
7934   with FuncRec do
7935     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7936 end;
7937
7938 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7939 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7940 type
7941   TVec = Array[0..2] of Single;
7942 var
7943   Idx: Integer;
7944   du, dv: Double;
7945   Len: Single;
7946   Vec: TVec;
7947
7948   function GetHeight(X, Y: Integer): Single;
7949   begin
7950     with FuncRec do begin
7951       X := Max(0, Min(Size.X -1, X));
7952       Y := Max(0, Min(Size.Y -1, Y));
7953       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7954     end;
7955   end;
7956
7957 begin
7958   with FuncRec do begin
7959     with PglBitmapToNormalMapRec(Args)^ do begin
7960       du := 0;
7961       for Idx := Low(MatrixU) to High(MatrixU) do
7962         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7963
7964       dv := 0;
7965       for Idx := Low(MatrixU) to High(MatrixU) do
7966         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7967
7968       Vec[0] := -du * Scale;
7969       Vec[1] := -dv * Scale;
7970       Vec[2] := 1;
7971     end;
7972
7973     // Normalize
7974     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7975     if Len <> 0 then begin
7976       Vec[0] := Vec[0] * Len;
7977       Vec[1] := Vec[1] * Len;
7978       Vec[2] := Vec[2] * Len;
7979     end;
7980
7981     // Farbe zuweisem
7982     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7983     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7984     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7985   end;
7986 end;
7987
7988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7989 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7990 var
7991   Rec: TglBitmapToNormalMapRec;
7992
7993   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7994   begin
7995     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7996       Matrix[Index].X := X;
7997       Matrix[Index].Y := Y;
7998       Matrix[Index].W := W;
7999     end;
8000   end;
8001
8002 begin
8003   if TFormatDescriptor.Get(Format).IsCompressed then
8004     raise EglBitmapUnsupportedFormat.Create(Format);
8005
8006   if aScale > 100 then
8007     Rec.Scale := 100
8008   else if aScale < -100 then
8009     Rec.Scale := -100
8010   else
8011     Rec.Scale := aScale;
8012
8013   SetLength(Rec.Heights, Width * Height);
8014   try
8015     case aFunc of
8016       nm4Samples: begin
8017         SetLength(Rec.MatrixU, 2);
8018         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8019         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8020
8021         SetLength(Rec.MatrixV, 2);
8022         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8023         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8024       end;
8025
8026       nmSobel: begin
8027         SetLength(Rec.MatrixU, 6);
8028         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8029         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8030         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8031         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8032         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8033         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8034
8035         SetLength(Rec.MatrixV, 6);
8036         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8037         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8038         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8039         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8040         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8041         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8042       end;
8043
8044       nm3x3: begin
8045         SetLength(Rec.MatrixU, 6);
8046         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8047         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8048         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8049         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8050         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8051         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8052
8053         SetLength(Rec.MatrixV, 6);
8054         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8055         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8056         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8057         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8058         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8059         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8060       end;
8061
8062       nm5x5: begin
8063         SetLength(Rec.MatrixU, 20);
8064         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8065         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8066         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8067         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8068         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8069         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8070         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8071         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8072         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8073         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8074         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8075         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8076         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8077         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8078         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8079         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8080         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8081         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8082         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8083         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8084
8085         SetLength(Rec.MatrixV, 20);
8086         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8087         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8088         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8089         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8090         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8091         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8092         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8093         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8094         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8095         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8096         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8097         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8098         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8099         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8100         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8101         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8102         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8103         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8104         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8105         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8106       end;
8107     end;
8108
8109     // Daten Sammeln
8110     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8111       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8112     else
8113       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8114     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8115   finally
8116     SetLength(Rec.Heights, 0);
8117   end;
8118 end;
8119
8120 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8121 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8123 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8124 begin
8125   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8126 end;
8127
8128 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8129 procedure TglBitmapCubeMap.AfterConstruction;
8130 begin
8131   inherited;
8132
8133   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8134     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8135
8136   SetWrap;
8137   Target   := GL_TEXTURE_CUBE_MAP;
8138   fGenMode := GL_REFLECTION_MAP;
8139 end;
8140
8141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8142 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8143 var
8144   BuildWithGlu: Boolean;
8145   TexSize: Integer;
8146 begin
8147   if (aTestTextureSize) then begin
8148     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8149
8150     if (Height > TexSize) or (Width > TexSize) then
8151       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8152
8153     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8154       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8155   end;
8156
8157   if (ID = 0) then
8158     CreateID;
8159   SetupParameters(BuildWithGlu);
8160   UploadData(aCubeTarget, BuildWithGlu);
8161 end;
8162
8163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8164 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8165 begin
8166   inherited Bind (aEnableTextureUnit);
8167   if aEnableTexCoordsGen then begin
8168     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8169     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8170     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8171     glEnable(GL_TEXTURE_GEN_S);
8172     glEnable(GL_TEXTURE_GEN_T);
8173     glEnable(GL_TEXTURE_GEN_R);
8174   end;
8175 end;
8176
8177 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8178 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8179 begin
8180   inherited Unbind(aDisableTextureUnit);
8181   if aDisableTexCoordsGen then begin
8182     glDisable(GL_TEXTURE_GEN_S);
8183     glDisable(GL_TEXTURE_GEN_T);
8184     glDisable(GL_TEXTURE_GEN_R);
8185   end;
8186 end;
8187
8188 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8189 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8191 type
8192   TVec = Array[0..2] of Single;
8193   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8194
8195   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8196   TglBitmapNormalMapRec = record
8197     HalfSize : Integer;
8198     Func: TglBitmapNormalMapGetVectorFunc;
8199   end;
8200
8201   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8202 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8203 begin
8204   aVec[0] := aHalfSize;
8205   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8206   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8207 end;
8208
8209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8210 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8211 begin
8212   aVec[0] := - aHalfSize;
8213   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8214   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8215 end;
8216
8217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8218 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8219 begin
8220   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8221   aVec[1] := aHalfSize;
8222   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8223 end;
8224
8225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8226 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8227 begin
8228   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8229   aVec[1] := - aHalfSize;
8230   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8231 end;
8232
8233 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8234 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8235 begin
8236   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8237   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8238   aVec[2] := aHalfSize;
8239 end;
8240
8241 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8242 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8243 begin
8244   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8245   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8246   aVec[2] := - aHalfSize;
8247 end;
8248
8249 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8250 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8251 var
8252   i: Integer;
8253   Vec: TVec;
8254   Len: Single;
8255 begin
8256   with FuncRec do begin
8257     with PglBitmapNormalMapRec(Args)^ do begin
8258       Func(Vec, Position, HalfSize);
8259
8260       // Normalize
8261       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8262       if Len <> 0 then begin
8263         Vec[0] := Vec[0] * Len;
8264         Vec[1] := Vec[1] * Len;
8265         Vec[2] := Vec[2] * Len;
8266       end;
8267
8268       // Scale Vector and AddVectro
8269       Vec[0] := Vec[0] * 0.5 + 0.5;
8270       Vec[1] := Vec[1] * 0.5 + 0.5;
8271       Vec[2] := Vec[2] * 0.5 + 0.5;
8272     end;
8273
8274     // Set Color
8275     for i := 0 to 2 do
8276       Dest.Data.arr[i] := Round(Vec[i] * 255);
8277   end;
8278 end;
8279
8280 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8281 procedure TglBitmapNormalMap.AfterConstruction;
8282 begin
8283   inherited;
8284   fGenMode := GL_NORMAL_MAP;
8285 end;
8286
8287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8288 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8289 var
8290   Rec: TglBitmapNormalMapRec;
8291   SizeRec: TglBitmapPixelPosition;
8292 begin
8293   Rec.HalfSize := aSize div 2;
8294   FreeDataAfterGenTexture := false;
8295
8296   SizeRec.Fields := [ffX, ffY];
8297   SizeRec.X := aSize;
8298   SizeRec.Y := aSize;
8299
8300   // Positive X
8301   Rec.Func := glBitmapNormalMapPosX;
8302   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8303   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8304
8305   // Negative X
8306   Rec.Func := glBitmapNormalMapNegX;
8307   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8308   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8309
8310   // Positive Y
8311   Rec.Func := glBitmapNormalMapPosY;
8312   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8313   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8314
8315   // Negative Y
8316   Rec.Func := glBitmapNormalMapNegY;
8317   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8318   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8319
8320   // Positive Z
8321   Rec.Func := glBitmapNormalMapPosZ;
8322   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8323   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8324
8325   // Negative Z
8326   Rec.Func := glBitmapNormalMapNegZ;
8327   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8328   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8329 end;
8330
8331
8332 initialization
8333   glBitmapSetDefaultFormat (tfEmpty);
8334   glBitmapSetDefaultMipmap (mmMipmap);
8335   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8336   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8337   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8338
8339   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8340   glBitmapSetDefaultDeleteTextureOnFree    (true);
8341
8342   TFormatDescriptor.Init;
8343
8344 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8345   OpenGLInitialized := false;
8346   InitOpenGLCS := TCriticalSection.Create;
8347 {$ENDIF}
8348
8349 finalization
8350   TFormatDescriptor.Finalize;
8351
8352 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8353   FreeAndNil(InitOpenGLCS);
8354 {$ENDIF}
8355
8356 end.
8357