glBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4 ------------------------------------------------------------
   5 The contents of this file are used with permission, subject to
   6 the Mozilla Public License Version 1.1 (the "License"); you may
   7 not use this file except in compliance with the License. You may
   8 obtain a copy of the License at
   9 http://www.mozilla.org/MPL/MPL-1.1.html
  10 ------------------------------------------------------------
  11 Version 2.0.3
  12 ------------------------------------------------------------
  13 History
  14 21-03-2010
  15 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  16   then it's your problem if that isn't true. This prevents the unit for incompatibility
  17   with newer versions of Delphi.
  18 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  19 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  20 10-08-2008
  21 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  22 - Additional Datapointer for functioninterface now has the name CustomData
  23 24-07-2008
  24 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  25 - If you load an texture from an file the property Filename will be set to the name of the file
  26 - Three new properties to attach custom data to the Texture objects
  27   - CustomName  (free for use string)
  28   - CustomNameW (free for use widestring)
  29   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  30 27-05-2008
  31 - RLE TGAs loaded much faster
  32 26-05-2008
  33 - fixed some problem with reading RLE TGAs.
  34 21-05-2008
  35 - function clone now only copys data if it's assigned and now it also copies the ID
  36 - it seems that lazarus dont like comments in comments.
  37 01-05-2008
  38 - It's possible to set the id of the texture
  39 - define GLB_NO_NATIVE_GL deactivated by default
  40 27-04-2008
  41 - Now supports the following libraries
  42   - SDL and SDL_image
  43   - libPNG
  44   - libJPEG
  45 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  46 - BMPs now loaded manuel
  47 - Large restructuring
  48 - Property DataPtr now has the name Data
  49 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  50 - Unused Depth removed
  51 - Function FreeData to freeing image data added
  52 24-10-2007
  53 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  54 15-11-2006
  55 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  56 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  57 - Function ReadOpenGLExtension is now only intern
  58 29-06-2006
  59 - pngimage now disabled by default like all other versions.
  60 26-06-2006
  61 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  62 22-06-2006
  63 - Fixed some Problem with Delphi 5
  64 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  65 22-03-2006
  66 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  67 09-03-2006
  68 - Internal Format ifDepth8 added
  69 - function GrabScreen now supports all uncompressed formats
  70 31-01-2006
  71 - AddAlphaFromglBitmap implemented
  72 29-12-2005
  73 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  74 28-12-2005
  75 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  76   property Width, Height, Depth are still existing and new property Dimension are avail
  77 11-12-2005
  78 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  79 19-10-2005
  80 - Added function GrabScreen to class TglBitmap2D
  81 18-10-2005
  82 - Added support to Save images
  83 - Added function Clone to Clone Instance
  84 11-10-2005
  85 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  86   Usefull for Future
  87 - Several speed optimizations
  88 09-10-2005
  89 - Internal structure change. Loading of TGA, PNG and DDS improved.
  90   Data, format and size will now set directly with SetDataPtr.
  91 - AddFunc now works with all Types of Images and Formats
  92 - Some Funtions moved to Baseclass TglBitmap
  93 06-10-2005
  94 - Added Support to decompress DXT3 and DXT5 compressed Images.
  95 - Added Mapping to convert data from one format into an other.
  96 05-10-2005
  97 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  98   supported Input format (supported by GetPixel) into any uncompresed Format
  99 - Added Support to decompress DXT1 compressed Images.
 100 - SwapColors replaced by ConvertTo
 101 04-10-2005
 102 - Added Support for compressed DDSs
 103 - Added new internal formats (DXT1, DXT3, DXT5)
 104 29-09-2005
 105 - Parameter Components renamed to InternalFormat
 106 23-09-2005
 107 - Some AllocMem replaced with GetMem (little speed change)
 108 - better exception handling. Better protection from memory leaks.
 109 22-09-2005
 110 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 111 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 112 07-09-2005
 113 - Added support for Grayscale textures
 114 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 115 10-07-2005
 116 - Added support for GL_VERSION_2_0
 117 - Added support for GL_EXT_texture_filter_anisotropic
 118 04-07-2005
 119 - Function FillWithColor fills the Image with one Color
 120 - Function LoadNormalMap added
 121 30-06-2005
 122 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 123 - ToNormalMap now supports Sobel (nmSobel) function.
 124 29-06-2005
 125 - support for RLE Compressed RGB TGAs added
 126 28-06-2005
 127 - Class TglBitmapNormalMap added to support Normalmap generation
 128 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 129   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 130 16-06-2005
 131 - Method LoadCubeMapClass removed
 132 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 133 - virtual abstract method GenTexture in class TglBitmap now is protected
 134 12-06-2005
 135 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 136 10-06-2005
 137 - little enhancement for IsPowerOfTwo
 138 - TglBitmap1D.GenTexture now tests NPOT Textures
 139 06-06-2005
 140 - some little name changes. All properties or function with Texture in name are
 141   now without texture in name. We have allways texture so we dosn't name it.
 142 03-06-2005
 143 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 144   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 145 02-06-2005
 146 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 147 25-04-2005
 148 - Function Unbind added
 149 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 150 21-04-2005
 151 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 152 29-03-2005
 153 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 154   To Enable png's use the define pngimage
 155 22-03-2005
 156 - New Functioninterface added
 157 - Function GetPixel added
 158 27-11-2004
 159 - Property BuildMipMaps renamed to MipMap
 160 21-11-2004
 161 - property Name removed.
 162 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 163 22-05-2004
 164 - property name added. Only used in glForms!
 165 26-11-2003
 166 - property FreeDataAfterGenTexture is now available as default (default = true)
 167 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 168 - function MoveMemory replaced with function Move (little speed change)
 169 - several calculations stored in variables (little speed change)
 170 29-09-2003
 171 - property BuildMipsMaps added (default = true)
 172   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 173 - property FreeDataAfterGenTexture added (default = true)
 174   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 175 - parameter DisableOtherTextureUnits of Bind removed
 176 - parameter FreeDataAfterGeneration of GenTextures removed
 177 12-09-2003
 178 - TglBitmap dosn't delete data if class was destroyed (fixed)
 179 09-09-2003
 180 - Bind now enables TextureUnits (by params)
 181 - GenTextures can leave data (by param)
 182 - LoadTextures now optimal
 183 03-09-2003
 184 - Performance optimization in AddFunc
 185 - procedure Bind moved to subclasses
 186 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 187 19-08-2003
 188 - Texturefilter and texturewrap now also as defaults
 189   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 190   Magfilter = GL_LINEAR
 191   Wrap(str) = GL_CLAMP_TO_EDGE
 192 - Added new format tfCompressed to create a compressed texture.
 193 - propertys IsCompressed, TextureSize and IsResident added
 194   IsCompressed and TextureSize only contains data from level 0
 195 18-08-2003
 196 - Added function AddFunc to add PerPixelEffects to Image
 197 - LoadFromFunc now based on AddFunc
 198 - Invert now based on AddFunc
 199 - SwapColors now based on AddFunc
 200 16-08-2003
 201 - Added function FlipHorz
 202 15-08-2003
 203 - Added function LaodFromFunc to create images with function
 204 - Added function FlipVert
 205 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 206 29-07-2003
 207 - Added Alphafunctions to calculate alpha per function
 208 - Added Alpha from ColorKey using alphafunctions
 209 28-07-2003
 210 - First full functionally Version of glBitmap
 211 - Support for 24Bit and 32Bit TGA Pictures added
 212 25-07-2003
 213 - begin of programming
 214 ***********************************************************}
 215 unit glBitmap;
 216
 217 {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 218 // Please uncomment the defines below to configure the glBitmap to your preferences.
 219 // If you have configured the unit you can uncomment the warning above.
 220
 221 // ###### Start of preferences ################################################
 222
 223 {$DEFINE GLB_NO_NATIVE_GL}
 224 // To enable the dglOpenGL.pas Header
 225 // With native GL then bindings are staticlly declared to support other headers
 226 // or use the glBitmap inside of DLLs (minimize codesize).
 227
 228
 229 {.$DEFINE GLB_SDL}
 230 // To enable the support for SDL_surfaces
 231
 232 {.$DEFINE GLB_DELPHI}
 233 // To enable the support for TBitmap from Delphi (not lazarus)
 234
 235
 236 // *** image libs ***
 237
 238 {.$DEFINE GLB_SDL_IMAGE}
 239 // To enable the support of SDL_image to load files. (READ ONLY)
 240 // If you enable SDL_image all other libraries will be ignored!
 241
 242
 243 {.$DEFINE GLB_PNGIMAGE}
 244 // to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/
 245 // if you enable pngimage the libPNG will be ignored
 246
 247 {.$DEFINE GLB_LIB_PNG}
 248 // to use the libPNG http://www.libpng.org/
 249 // You will need an aditional header.
 250 // http://www.opengl24.de/index.php?cat=header&file=libpng
 251
 252 {.$DEFINE GLB_DELPHI_JPEG}
 253 // if you enable delphi jpegs the libJPEG will be ignored
 254
 255 {.$DEFINE GLB_LIB_JPEG}
 256 // to use the libJPEG http://www.ijg.org/
 257 // You will need an aditional header.
 258 // http://www.opengl24.de/index.php?cat=header&file=libjpeg
 259
 260 // ###### End of preferences ##################################################
 261
 262
 263 // ###### PRIVATE. Do not change anything. ####################################
 264 // *** old defines for compatibility ***
 265 {$IFDEF NO_NATIVE_GL}
 266   {$DEFINE GLB_NO_NATIVE_GL}
 267 {$ENDIF}
 268 {$IFDEF pngimage}
 269   {$definde GLB_PNGIMAGE}
 270 {$ENDIF}
 271
 272 // *** Delphi Versions ***
 273 {$IFDEF fpc}
 274   {$MODE Delphi}
 275
 276   {$IFDEF CPUI386}
 277     {$DEFINE CPU386}
 278     {$ASMMODE INTEL}
 279   {$ENDIF}
 280
 281   {$IFNDEF WINDOWS}
 282     {$linklib c}
 283   {$ENDIF}
 284 {$ENDIF}
 285
 286 // *** checking define combinations ***
 287 {$IFDEF GLB_SDL_IMAGE}
 288   {$IFNDEF GLB_SDL}
 289     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 290     {$DEFINE GLB_SDL}
 291   {$ENDIF}
 292   {$IFDEF GLB_PNGIMAGE}
 293     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 294     {$undef GLB_PNGIMAGE}
 295   {$ENDIF}
 296   {$IFDEF GLB_DELPHI_JPEG}
 297     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 298     {$undef GLB_DELPHI_JPEG}
 299   {$ENDIF}
 300   {$IFDEF GLB_LIB_PNG}
 301     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 302     {$undef GLB_LIB_PNG}
 303   {$ENDIF}
 304   {$IFDEF GLB_LIB_JPEG}
 305     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 306     {$undef GLB_LIB_JPEG}
 307   {$ENDIF}
 308
 309   {$DEFINE GLB_SUPPORT_PNG_READ}
 310   {$DEFINE GLB_SUPPORT_JPEG_READ}
 311 {$ENDIF}
 312
 313 {$IFDEF GLB_PNGIMAGE}
 314   {$IFDEF GLB_LIB_PNG}
 315     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 316     {$undef GLB_LIB_PNG}
 317   {$ENDIF}
 318
 319   {$DEFINE GLB_SUPPORT_PNG_READ}
 320   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 321 {$ENDIF}
 322
 323 {$IFDEF GLB_LIB_PNG}
 324   {$DEFINE GLB_SUPPORT_PNG_READ}
 325   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 326 {$ENDIF}
 327
 328 {$IFDEF GLB_DELPHI_JPEG}
 329   {$IFDEF GLB_LIB_JPEG}
 330     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 331     {$undef GLB_LIB_JPEG}
 332   {$ENDIF}
 333
 334   {$DEFINE GLB_SUPPORT_JPEG_READ}
 335   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 336 {$ENDIF}
 337
 338 {$IFDEF GLB_LIB_JPEG}
 339   {$DEFINE GLB_SUPPORT_JPEG_READ}
 340   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 341 {$ENDIF}
 342
 343 // *** general options ***
 344 {$EXTENDEDSYNTAX ON}
 345 {$LONGSTRINGS ON}
 346 {$ALIGN ON}
 347 {$IFNDEF FPC}
 348   {$OPTIMIZATION ON}
 349 {$ENDIF}
 350
 351 interface
 352
 353 uses
 354   {$IFDEF GLB_NO_NATIVE_GL} dglOpenGL,                            {$ENDIF}
 355
 356   {$IFDEF GLB_SDL}          SDL,                                  {$ENDIF}
 357   {$IFDEF GLB_DELPHI}       Dialogs, Windows, Graphics,           {$ENDIF}
 358
 359   {$IFDEF GLB_SDL_IMAGE}    SDL_image,                            {$ENDIF}
 360
 361   {$IFDEF GLB_PNGIMAGE}     pngimage,                             {$ENDIF}
 362   {$IFDEF GLB_LIB_PNG}      libPNG,                               {$ENDIF}
 363
 364   {$IFDEF GLB_DELPHI_JPEG}  JPEG,                                 {$ENDIF}
 365   {$IFDEF GLB_LIB_JPEG}     libJPEG,                              {$ENDIF}
 366   Classes, SysUtils;
 367
 368 {$IFNDEF GLB_DELPHI}
 369 type
 370   HGLRC = Cardinal;
 371   DWORD = Cardinal;
 372   PDWORD = ^DWORD;
 373
 374   TRGBQuad = packed record
 375     rgbBlue: Byte;
 376     rgbGreen: Byte;
 377     rgbRed: Byte;
 378     rgbReserved: Byte;
 379   end;
 380 {$ENDIF}
 381
 382 (* TODO dglOpenGL
 383 {$IFNDEF GLB_NO_NATIVE_GL}
 384 // Native OpenGL Implementation
 385 type
 386   PByteBool = ^ByteBool;
 387
 388 {$IFDEF GLB_DELPHI}
 389 var
 390   gLastContext: HGLRC;
 391 {$ENDIF}
 392
 393 const
 394   // Generell
 395   GL_VERSION = $1F02;
 396   GL_EXTENSIONS = $1F03;
 397
 398   GL_TRUE = 1;
 399   GL_FALSE = 0;
 400
 401   GL_TEXTURE_1D = $0DE0;
 402   GL_TEXTURE_2D = $0DE1;
 403
 404   GL_MAX_TEXTURE_SIZE = $0D33;
 405   GL_PACK_ALIGNMENT = $0D05;
 406   GL_UNPACK_ALIGNMENT = $0CF5;
 407
 408   // Textureformats
 409   GL_RGB = $1907;
 410   GL_RGB4 = $804F;
 411   GL_RGB8 = $8051;
 412   GL_RGBA = $1908;
 413   GL_RGBA4 = $8056;
 414   GL_RGBA8 = $8058;
 415   GL_BGR = $80E0;
 416   GL_BGRA = $80E1;
 417   GL_ALPHA4 = $803B;
 418   GL_ALPHA8 = $803C;
 419   GL_LUMINANCE4 = $803F;
 420   GL_LUMINANCE8 = $8040;
 421   GL_LUMINANCE4_ALPHA4 = $8043;
 422   GL_LUMINANCE8_ALPHA8 = $8045;
 423   GL_DEPTH_COMPONENT = $1902;
 424
 425   GL_UNSIGNED_BYTE = $1401;
 426   GL_ALPHA = $1906;
 427   GL_LUMINANCE = $1909;
 428   GL_LUMINANCE_ALPHA = $190A;
 429
 430   GL_TEXTURE_WIDTH = $1000;
 431   GL_TEXTURE_HEIGHT = $1001;
 432   GL_TEXTURE_INTERNAL_FORMAT = $1003;
 433   GL_TEXTURE_RED_SIZE = $805C;
 434   GL_TEXTURE_GREEN_SIZE = $805D;
 435   GL_TEXTURE_BLUE_SIZE = $805E;
 436   GL_TEXTURE_ALPHA_SIZE = $805F;
 437   GL_TEXTURE_LUMINANCE_SIZE = $8060;
 438
 439   // Dataformats
 440   GL_UNSIGNED_SHORT_5_6_5 = $8363;
 441   GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
 442   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 443   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 444   GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
 445
 446   // Filter
 447   GL_NEAREST = $2600;
 448   GL_LINEAR = $2601;
 449   GL_NEAREST_MIPMAP_NEAREST = $2700;
 450   GL_LINEAR_MIPMAP_NEAREST = $2701;
 451   GL_NEAREST_MIPMAP_LINEAR = $2702;
 452   GL_LINEAR_MIPMAP_LINEAR = $2703;
 453   GL_TEXTURE_MAG_FILTER = $2800;
 454   GL_TEXTURE_MIN_FILTER = $2801;
 455
 456   // Wrapmodes
 457   GL_TEXTURE_WRAP_S = $2802;
 458   GL_TEXTURE_WRAP_T = $2803;
 459   GL_CLAMP = $2900;
 460   GL_REPEAT = $2901;
 461   GL_CLAMP_TO_EDGE = $812F;
 462   GL_CLAMP_TO_BORDER = $812D;
 463   GL_TEXTURE_WRAP_R = $8072;
 464
 465   GL_MIRRORED_REPEAT = $8370;
 466
 467   // Border Color
 468   GL_TEXTURE_BORDER_COLOR = $1004;
 469
 470   // Texgen
 471   GL_NORMAL_MAP = $8511;
 472   GL_REFLECTION_MAP = $8512;
 473   GL_S = $2000;
 474   GL_T = $2001;
 475   GL_R = $2002;
 476   GL_TEXTURE_GEN_MODE = $2500;
 477   GL_TEXTURE_GEN_S = $0C60;
 478   GL_TEXTURE_GEN_T = $0C61;
 479   GL_TEXTURE_GEN_R = $0C62;
 480
 481   // Cubemaps
 482   GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
 483   GL_TEXTURE_CUBE_MAP = $8513;
 484   GL_TEXTURE_BINDING_CUBE_MAP = $8514;
 485   GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
 486   GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
 487   GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
 488   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
 489   GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
 490   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
 491
 492   GL_TEXTURE_RECTANGLE_ARB = $84F5;
 493
 494   // GL_SGIS_generate_mipmap
 495   GL_GENERATE_MIPMAP = $8191;
 496
 497   // GL_EXT_texture_compression_s3tc
 498   GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
 499   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
 500   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
 501   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
 502
 503   // GL_EXT_texture_filter_anisotropic
 504   GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
 505   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 506
 507   // GL_ARB_texture_compression
 508   GL_COMPRESSED_RGB = $84ED;
 509   GL_COMPRESSED_RGBA = $84EE;
 510   GL_COMPRESSED_ALPHA = $84E9;
 511   GL_COMPRESSED_LUMINANCE = $84EA;
 512   GL_COMPRESSED_LUMINANCE_ALPHA = $84EB;
 513
 514   // Extensions
 515 var
 516   GL_VERSION_1_2,
 517   GL_VERSION_1_3,
 518   GL_VERSION_1_4,
 519   GL_VERSION_2_0,
 520
 521   GL_ARB_texture_border_clamp,
 522   GL_ARB_texture_cube_map,
 523   GL_ARB_texture_compression,
 524   GL_ARB_texture_non_power_of_two,
 525   GL_ARB_texture_rectangle,
 526   GL_ARB_texture_mirrored_repeat,
 527   GL_EXT_bgra,
 528   GL_EXT_texture_edge_clamp,
 529   GL_EXT_texture_cube_map,
 530   GL_EXT_texture_compression_s3tc,
 531   GL_EXT_texture_filter_anisotropic,
 532   GL_EXT_texture_rectangle,
 533   GL_NV_texture_rectangle,
 534   GL_IBM_texture_mirrored_repeat,
 535   GL_SGIS_generate_mipmap: Boolean;
 536
 537 const
 538 {$IFDEF LINUX}
 539   libglu = 'libGLU.so.1';
 540   libopengl = 'libGL.so.1';
 541 {$else}
 542   libglu = 'glu32.dll';
 543   libopengl = 'opengl32.dll';
 544 {$ENDIF}
 545
 546 {$IFDEF LINUX}
 547   function glXGetProcAddress(ProcName: PAnsiChar): Pointer; cdecl; external libopengl;
 548 {$else}
 549   function wglGetProcAddress(ProcName: PAnsiChar): Pointer; stdcall; external libopengl;
 550 {$ENDIF}
 551
 552   function glGetString(name: Cardinal): PAnsiChar; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 553
 554   procedure glEnable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 555   procedure glDisable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 556   procedure glGetIntegerv(pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 557
 558   procedure glTexImage1D(target: Cardinal; level, internalformat, width, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 559   procedure glTexImage2D(target: Cardinal; level, internalformat, width, height, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 560
 561   procedure glGenTextures(n: Integer; Textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 562   procedure glBindTexture(target: Cardinal; Texture: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 563   procedure glDeleteTextures(n: Integer; const textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 564
 565   procedure glReadPixels(x, y: Integer; width, height: Integer; format, atype: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 566   procedure glPixelStorei(pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 567   procedure glGetTexImage(target: Cardinal; level: Integer; format: Cardinal; _type: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 568
 569   function glAreTexturesResident(n: Integer; const Textures: PCardinal; residences: PByteBool): ByteBool;  {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 570   procedure glTexParameteri(target: Cardinal; pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 571   procedure glTexParameterfv(target: Cardinal; pname: Cardinal; const params: PSingle); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 572   procedure glGetTexLevelParameteriv(target: Cardinal; level: Integer; pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 573   procedure glTexGeni(coord, pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 574
 575   function gluBuild1DMipmaps(Target: Cardinal; Components, Width: Integer; Format, atype: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu;
 576   function gluBuild2DMipmaps(Target: Cardinal; Components, Width, Height: Integer; Format, aType: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu;
 577
 578 var
 579   glCompressedTexImage2D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width, height: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
 580   glCompressedTexImage1D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
 581   glGetCompressedTexImage : procedure(target: Cardinal; level: Integer; img: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
 582 {$ENDIF}
 583 *)
 584
 585 type
 586 ////////////////////////////////////////////////////////////////////////////////////////////////////
 587   EglBitmapException               = class(Exception);
 588   EglBitmapSizeToLargeException    = class(EglBitmapException);
 589   EglBitmapNonPowerOfTwoException  = class(EglBitmapException);
 590   EglBitmapUnsupportedFormatFormat = class(EglBitmapException);
 591
 592 ////////////////////////////////////////////////////////////////////////////////////////////////////
 593   TglBitmapFormat = (
 594     tfEmpty = 0,
 595
 596     tfAlpha4,
 597     tfAlpha8,
 598     tfAlpha12,
 599     tfAlpha16,
 600
 601     tfLuminance4,
 602     tfLuminance8,
 603     tfLuminance12,
 604     tfLuminance16,
 605
 606     tfLuminance4Alpha4,
 607     tfLuminance6Alpha2,
 608     tfLuminance8Alpha8,
 609     tfLuminance12Alpha4,
 610     tfLuminance12Alpha12,
 611     tfLuminance16Alpha16,
 612
 613     tfR3G3B2,
 614     tfRGB4,
 615     tfR5G6B5,
 616     tfRGB5,
 617     tfRGB8,
 618     tfRGB10,
 619     tfRGB12,
 620     tfRGB16,
 621
 622     tfRGBA2,
 623     tfRGBA4,
 624     tfRGB5A1,
 625     tfRGBA8,
 626     tfRGB10A2,
 627     tfRGBA12,
 628     tfRGBA16,
 629
 630     tfBGR4,
 631     tfB5G6R5,
 632     tfBGR5,
 633     tfBGR8,
 634     tfBGR10,
 635     tfBGR12,
 636     tfBGR16,
 637
 638     tfBGRA2,
 639     tfBGRA4,
 640     tfBGR5A1,
 641     tfBGRA8,
 642     tfBGR10A2,
 643     tfBGRA12,
 644     tfBGRA16,
 645
 646     tfDepth16,
 647     tfDepth24,
 648     tfDepth32
 649   );
 650
 651   TglBitmapFileType = (
 652      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 653      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 654      ftDDS,
 655      ftTGA,
 656      ftBMP);
 657    TglBitmapFileTypes = set of TglBitmapFileType;
 658
 659    TglBitmapMipMap = (
 660      mmNone,
 661      mmMipmap,
 662      mmMipmapGlu);
 663
 664    TglBitmapNormalMapFunc = (
 665      nm4Samples,
 666      nmSobel,
 667      nm3x3,
 668      nm5x5);
 669
 670 ////////////////////////////////////////////////////////////////////////////////////////////////////
 671   TglBitmapColorRec = packed record
 672   case Integer of
 673     0: (r, g, b, a: Cardinal);
 674     1: (arr: array[0..3] of Cardinal);
 675   end;
 676
 677   TglBitmapPixelData = packed record
 678     Data, Range: TglBitmapColorRec;
 679     Format: TglBitmapFormat;
 680   end;
 681   PglBitmapPixelData = ^TglBitmapPixelData;
 682
 683 ////////////////////////////////////////////////////////////////////////////////////////////////////
 684   TglBitmapPixelPositionFields = set of (ffX, ffY);
 685   TglBitmapPixelPosition = record
 686     Fields : TglBitmapPixelPositionFields;
 687     X : Word;
 688     Y : Word;
 689   end;
 690
 691 ////////////////////////////////////////////////////////////////////////////////////////////////////
 692   TglBitmap = class;
 693   TglBitmapFunctionRec = record
 694     Sender:   TglBitmap;
 695     Size:     TglBitmapPixelPosition;
 696     Position: TglBitmapPixelPosition;
 697     Source:   TglBitmapPixelData;
 698     Dest:     TglBitmapPixelData;
 699     Args:     PtrInt;
 700   end;
 701   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 702
 703 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 704   TglBitmap = class
 705   protected
 706     fID: GLuint;
 707     fTarget: GLuint;
 708     fAnisotropic: Integer;
 709     fDeleteTextureOnFree: Boolean;
 710     fFreeDataAfterGenTexture: Boolean;
 711     fData: PByte;
 712     fIsResident: Boolean;
 713     fBorderColor: array[0..3] of Single;
 714
 715     fDimension: TglBitmapPixelPosition;
 716     fMipMap: TglBitmapMipMap;
 717     fFormat: TglBitmapFormat;
 718
 719     // Mapping
 720     fPixelSize: Integer;
 721     fRowSize: Integer;
 722
 723     // Filtering
 724     fFilterMin: Cardinal;
 725     fFilterMag: Cardinal;
 726
 727     // TexturWarp
 728     fWrapS: Cardinal;
 729     fWrapT: Cardinal;
 730     fWrapR: Cardinal;
 731
 732     // CustomData
 733     fFilename: String;
 734     fCustomName: String;
 735     fCustomNameW: WideString;
 736     fCustomData: Pointer;
 737
 738     //Getter
 739     function GetWidth:  Integer; virtual;
 740     function GetHeight: Integer; virtual;
 741
 742     function GetFileWidth:  Integer; virtual;
 743     function GetFileHeight: Integer; virtual;
 744
 745     //Setter
 746     procedure SetCustomData(const aValue: Pointer);
 747     procedure SetCustomName(const aValue: String);
 748     procedure SetCustomNameW(const aValue: WideString);
 749     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 750     procedure SetFormat(const aValue: TglBitmapFormat);
 751     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 752     procedure SetID(const aValue: Cardinal);
 753     procedure SetMipMap(const aValue: TglBitmapMipMap);
 754     procedure SetTarget(const aValue: Cardinal);
 755     procedure SetAnisotropic(const aValue: Integer);
 756
 757     procedure CreateID;
 758     procedure SetupParameters(var aBuildWithGlu: Boolean);
 759     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
 760       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 761     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 762
 763     function FlipHorz: Boolean; virtual;
 764     function FlipVert: Boolean; virtual;
 765
 766     property Width:  Integer read GetWidth;
 767     property Height: Integer read GetHeight;
 768
 769     property FileWidth:  Integer read GetFileWidth;
 770     property FileHeight: Integer read GetFileHeight;
 771   public
 772     //Properties
 773     property ID:           Cardinal        read fID          write SetID;
 774     property Target:       Cardinal        read fTarget      write SetTarget;
 775     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 776     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 777     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 778
 779     property Filename:    String     read fFilename;
 780     property CustomName:  String     read fCustomName  write SetCustomName;
 781     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
 782     property CustomData:  Pointer    read fCustomData  write SetCustomData;
 783
 784     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
 785     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
 786
 787     property Dimension:  TglBitmapPixelPosition  read fDimension;
 788     property Data:       PByte                   read fData;
 789     property IsResident: Boolean                 read fIsResident;
 790
 791     procedure AfterConstruction; override;
 792     procedure BeforeDestruction; override;
 793
 794     //Load
 795     procedure LoadFromFile(const aFilename: String);
 796     procedure LoadFromStream(const aStream: TStream); virtual;
 797     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
 798       const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0);
 799     {$IFDEF GLB_DELPHI}
 800     procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
 801     procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 802     {$ENDIF}
 803
 804     //Save
 805     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
 806     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 807
 808     //Convert
 809     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt = 0): Boolean; overload;
 810     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 811       const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0): Boolean; overload;
 812   public
 813     //Alpha & Co
 814     {$IFDEF GLB_SDL}
 815     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 816     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 817     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 818     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
 819       const aArgs: PtrInt = 0): Boolean;
 820     {$ENDIF}
 821
 822     {$IFDEF GLB_DELPHI}
 823     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 824     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 825     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 826     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
 827       const aArgs: PtrInt = 0): Boolean;
 828     function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
 829       const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 830     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
 831       const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 832     {$ENDIF}
 833
 834     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0): Boolean; virtual;
 835     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 836     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 837     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 838
 839     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 840     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 841     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 842
 843     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 844     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 845     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 846
 847     function RemoveAlpha: Boolean; virtual;
 848   public
 849     //Common
 850     function Clone: TglBitmap;
 851     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 852     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
 853     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
 854     procedure FreeData;
 855
 856     //ColorFill
 857     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 858     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 859     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
 860
 861     //TexParameters
 862     procedure SetFilter(const aMin, aMag: Cardinal);
 863     procedure SetWrap(
 864       const S: Cardinal = GL_CLAMP_TO_EDGE;
 865       const T: Cardinal = GL_CLAMP_TO_EDGE;
 866       const R: Cardinal = GL_CLAMP_TO_EDGE);
 867
 868     procedure GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);   virtual;
 869     procedure SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData); virtual;
 870
 871     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
 872     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
 873
 874     //Constructors
 875     constructor Create; overload;
 876     constructor Create(const aFileName: String); overload;
 877     constructor Create(const aStream: TStream); overload;
 878     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
 879     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0); overload;
 880     {$IFDEF GLB_DELPHI}
 881     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 882     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 883     {$ENDIF}
 884   private
 885     {$IFDEF GLB_SUPPORT_PNG_READ}
 886     function LoadPNG(const aStream: TStream): Boolean; virtual;
 887     procedure SavePNG(const aStream: TStream); virtual;
 888     {$ENDIF}
 889     {$IFDEF GLB_SUPPORT_JPEG_READ}
 890     function LoadJPEG(const aStream: TStream): Boolean; virtual;
 891     procedure SaveJPEG(const aStream: TStream); virtual;
 892     {$ENDIF}
 893     function LoadBMP(const aStream: TStream): Boolean; virtual;
 894     procedure SaveBMP(const aStream: TStream); virtual;
 895
 896     function LoadTGA(const aStream: TStream): Boolean; virtual;
 897     procedure SaveTGA(const aStream: TStream); virtual;
 898
 899     function LoadDDS(const aStream: TStream): Boolean; virtual;
 900     procedure SaveDDS(const aStream: TStream); virtual;
 901   end;
 902
 903 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 904   TglBitmap2D = class(TglBitmap)
 905   protected
 906     // Bildeinstellungen
 907     fLines: array of PByte;
 908
 909     (* TODO
 910     procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
 911     procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 912     procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 913     procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 914     procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 915     procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
 916     *)
 917
 918     function GetScanline(const aIndex: Integer): Pointer;
 919     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
 920       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
 921     procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
 922   public
 923     property Width;
 924     property Height;
 925     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
 926
 927     procedure AfterConstruction; override;
 928
 929     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
 930     procedure GetDataFromTexture;
 931     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
 932
 933     function FlipHorz: Boolean; override;
 934     function FlipVert: Boolean; override;
 935
 936     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
 937       const aScale: Single = 2; const aUseAlpha: Boolean = false);
 938   end;
 939
 940 (* TODO
 941   TglBitmapCubeMap = class(TglBitmap2D)
 942   protected
 943     fGenMode: Integer;
 944
 945     // Hide GenTexture
 946     procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
 947   public
 948     procedure AfterConstruction; override;
 949
 950     procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
 951
 952     procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
 953     procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
 954   end;
 955
 956
 957   TglBitmapNormalMap = class(TglBitmapCubeMap)
 958   public
 959     procedure AfterConstruction; override;
 960
 961     procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
 962   end;
 963
 964
 965   TglBitmap1D = class(TglBitmap)
 966   protected
 967     procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 968
 969     procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
 970     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
 971   public
 972     // propertys
 973     property Width;
 974
 975     procedure AfterConstruction; override;
 976
 977     // Other
 978     function FlipHorz: Boolean; override;
 979
 980     // Generation
 981     procedure GenTexture(TestTextureSize: Boolean = true); override;
 982   end;
 983 *)
 984
 985 const
 986   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
 987
 988 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
 989 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
 990 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
 991 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
 992 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
 993 procedure glBitmapSetDefaultWrap(
 994   const S: Cardinal = GL_CLAMP_TO_EDGE;
 995   const T: Cardinal = GL_CLAMP_TO_EDGE;
 996   const R: Cardinal = GL_CLAMP_TO_EDGE);
 997
 998 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
 999 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1000 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1001 function glBitmapGetDefaultFormat: TglBitmapFormat;
1002 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1003 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1004
1005 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1006 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1007
1008 var
1009   glBitmapDefaultDeleteTextureOnFree: Boolean;
1010   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1011   glBitmapDefaultFormat: TglBitmapFormat;
1012   glBitmapDefaultMipmap: TglBitmapMipMap;
1013   glBitmapDefaultFilterMin: Cardinal;
1014   glBitmapDefaultFilterMag: Cardinal;
1015   glBitmapDefaultWrapS: Cardinal;
1016   glBitmapDefaultWrapT: Cardinal;
1017   glBitmapDefaultWrapR: Cardinal;
1018
1019 {$IFDEF GLB_DELPHI}
1020 function CreateGrayPalette: HPALETTE;
1021 {$ENDIF}
1022
1023 implementation
1024
1025
1026     (* TODO
1027     function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
1028     function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
1029     function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1030     function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1031     function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
1032     *)
1033
1034 uses
1035   Math, syncobjs;
1036
1037 type
1038 ////////////////////////////////////////////////////////////////////////////////////////////////////
1039   TShiftRec = packed record
1040   case Integer of
1041     0: (r, g, b, a: Byte);
1042     1: (arr: array[0..3] of Byte);
1043   end;
1044
1045   TFormatDescriptor = class(TObject)
1046   private
1047     function GetRedMask: UInt64;
1048     function GetGreenMask: UInt64;
1049     function GetBlueMask: UInt64;
1050     function GetAlphaMask: UInt64;
1051   protected
1052     fFormat: TglBitmapFormat;
1053     fWithAlpha: TglBitmapFormat;
1054     fWithoutAlpha: TglBitmapFormat;
1055     fPixelSize: Single;
1056
1057     fRange: TglBitmapColorRec;
1058     fShift: TShiftRec;
1059
1060     fglFormat:         Cardinal;
1061     fglInternalFormat: Cardinal;
1062     fglDataFormat:     Cardinal;
1063
1064     function GetComponents: Integer; virtual;
1065   public
1066     property Format:       TglBitmapFormat read fFormat;
1067     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1068     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1069     property Components:   Integer         read GetComponents;
1070     property PixelSize:    Single          read fPixelSize;
1071
1072     property glFormat:         Cardinal read fglFormat;
1073     property glInternalFormat: Cardinal read fglInternalFormat;
1074     property glDataFormat:     Cardinal read fglDataFormat;
1075
1076     property Range: TglBitmapColorRec read fRange;
1077     property Shift: TShiftRec         read fShift;
1078
1079     property RedMask:   UInt64 read GetRedMask;
1080     property GreenMask: UInt64 read GetGreenMask;
1081     property BlueMask:  UInt64 read GetBlueMask;
1082     property AlphaMask: UInt64 read GetAlphaMask;
1083
1084     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1085     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1086
1087     function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
1088     function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
1089
1090     function CreateMappingData: Pointer; virtual;
1091     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1092
1093     function IsEmpty:  Boolean; virtual;
1094     function HasAlpha: Boolean; virtual;
1095     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean; virtual;
1096
1097     procedure PreparePixel(var aPixel: TglBitmapPixelData); virtual;
1098
1099     constructor Create; virtual;
1100   public
1101     class procedure Init;
1102     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1103     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1104     class procedure Clear;
1105     class procedure Finalize;
1106   end;
1107   TFormatDescriptorClass = class of TFormatDescriptor;
1108
1109   TfdEmpty = class(TFormatDescriptor);
1110
1111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1112   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1113     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1114     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1115     constructor Create; override;
1116   end;
1117
1118   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1119     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1120     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1121     constructor Create; override;
1122   end;
1123
1124   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1125     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1126     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1127     constructor Create; override;
1128   end;
1129
1130   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1131     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1132     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1133     constructor Create; override;
1134   end;
1135
1136   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1137     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1138     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1139     constructor Create; override;
1140   end;
1141
1142   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1143     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1144     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1145     constructor Create; override;
1146   end;
1147
1148   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1149     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1150     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1151     constructor Create; override;
1152   end;
1153
1154   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1155     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1156     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1157     constructor Create; override;
1158   end;
1159
1160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1161   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1162     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1163     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1164     constructor Create; override;
1165   end;
1166
1167   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1168     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1169     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1170     constructor Create; override;
1171   end;
1172
1173   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1174     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1175     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1176     constructor Create; override;
1177   end;
1178
1179   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1180     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1181     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1182     constructor Create; override;
1183   end;
1184
1185   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1186     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1187     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1188     constructor Create; override;
1189   end;
1190
1191   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1192     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1193     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1194     constructor Create; override;
1195   end;
1196
1197   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1198     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1199     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1200     constructor Create; override;
1201   end;
1202
1203   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1204     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1205     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1206     constructor Create; override;
1207   end;
1208
1209   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1210     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1211     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1212     constructor Create; override;
1213   end;
1214
1215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1216   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1217     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1218     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1219     constructor Create; override;
1220   end;
1221
1222   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1223     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1224     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1225     constructor Create; override;
1226   end;
1227
1228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1229   TfdAlpha4 = class(TfdAlpha_UB1)
1230     constructor Create; override;
1231   end;
1232
1233   TfdAlpha8 = class(TfdAlpha_UB1)
1234     constructor Create; override;
1235   end;
1236
1237   TfdAlpha12 = class(TfdAlpha_US1)
1238     constructor Create; override;
1239   end;
1240
1241   TfdAlpha16 = class(TfdAlpha_US1)
1242     constructor Create; override;
1243   end;
1244
1245   TfdLuminance4 = class(TfdLuminance_UB1)
1246     constructor Create; override;
1247   end;
1248
1249   TfdLuminance8 = class(TfdLuminance_UB1)
1250     constructor Create; override;
1251   end;
1252
1253   TfdLuminance12 = class(TfdLuminance_US1)
1254     constructor Create; override;
1255   end;
1256
1257   TfdLuminance16 = class(TfdLuminance_US1)
1258     constructor Create; override;
1259   end;
1260
1261   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1262     constructor Create; override;
1263   end;
1264
1265   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1266     constructor Create; override;
1267   end;
1268
1269   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1270     constructor Create; override;
1271   end;
1272
1273   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1274     constructor Create; override;
1275   end;
1276
1277   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1278     constructor Create; override;
1279   end;
1280
1281   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1282     constructor Create; override;
1283   end;
1284
1285   TfdR3G3B2 = class(TfdUniversal_UB1)
1286     constructor Create; override;
1287   end;
1288
1289   TfdRGB4 = class(TfdUniversal_US1)
1290     constructor Create; override;
1291   end;
1292
1293   TfdR5G6B5 = class(TfdUniversal_US1)
1294     constructor Create; override;
1295   end;
1296
1297   TfdRGB5 = class(TfdUniversal_US1)
1298     constructor Create; override;
1299   end;
1300
1301   TfdRGB8 = class(TfdRGB_UB3)
1302     constructor Create; override;
1303   end;
1304
1305   TfdRGB10 = class(TfdUniversal_UI1)
1306     constructor Create; override;
1307   end;
1308
1309   TfdRGB12 = class(TfdRGB_US3)
1310     constructor Create; override;
1311   end;
1312
1313   TfdRGB16 = class(TfdRGB_US3)
1314     constructor Create; override;
1315   end;
1316
1317   TfdRGBA2 = class(TfdRGBA_UB4)
1318     constructor Create; override;
1319   end;
1320
1321   TfdRGBA4 = class(TfdUniversal_US1)
1322     constructor Create; override;
1323   end;
1324
1325   TfdRGB5A1 = class(TfdUniversal_US1)
1326     constructor Create; override;
1327   end;
1328
1329   TfdRGBA8 = class(TfdRGBA_UB4)
1330     constructor Create; override;
1331   end;
1332
1333   TfdRGB10A2 = class(TfdUniversal_UI1)
1334     constructor Create; override;
1335   end;
1336
1337   TfdRGBA12 = class(TfdRGBA_US4)
1338     constructor Create; override;
1339   end;
1340
1341   TfdRGBA16 = class(TfdRGBA_US4)
1342     constructor Create; override;
1343   end;
1344
1345   TfdBGR4 = class(TfdUniversal_US1)
1346     constructor Create; override;
1347   end;
1348
1349   TfdB5G6R5 = class(TfdUniversal_US1)
1350     constructor Create; override;
1351   end;
1352
1353   TfdBGR5 = class(TfdUniversal_US1)
1354     constructor Create; override;
1355   end;
1356
1357   TfdBGR8 = class(TfdBGR_UB3)
1358     constructor Create; override;
1359   end;
1360
1361   TfdBGR10 = class(TfdUniversal_UI1)
1362     constructor Create; override;
1363   end;
1364
1365   TfdBGR12 = class(TfdBGR_US3)
1366     constructor Create; override;
1367   end;
1368
1369   TfdBGR16 = class(TfdBGR_US3)
1370     constructor Create; override;
1371   end;
1372
1373   TfdBGRA2 = class(TfdBGRA_UB4)
1374     constructor Create; override;
1375   end;
1376
1377   TfdBGRA4 = class(TfdUniversal_US1)
1378     constructor Create; override;
1379   end;
1380
1381   TfdBGR5A1 = class(TfdUniversal_US1)
1382     constructor Create; override;
1383   end;
1384
1385   TfdBGRA8 = class(TfdBGRA_UB4)
1386     constructor Create; override;
1387   end;
1388
1389   TfdBGR10A2 = class(TfdUniversal_UI1)
1390     constructor Create; override;
1391   end;
1392
1393   TfdBGRA12 = class(TfdBGRA_US4)
1394     constructor Create; override;
1395   end;
1396
1397   TfdBGRA16 = class(TfdBGRA_US4)
1398     constructor Create; override;
1399   end;
1400
1401   TfdDepth16 = class(TfdDepth_US1)
1402     constructor Create; override;
1403   end;
1404
1405   TfdDepth24 = class(TfdDepth_UI1)
1406     constructor Create; override;
1407   end;
1408
1409   TfdDepth32 = class(TfdDepth_UI1)
1410     constructor Create; override;
1411   end;
1412
1413 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1414   TBitfieldFormat = class(TFormatDescriptor)
1415   private
1416     procedure SetRedMask  (const aValue: UInt64);
1417     procedure SetGreenMask(const aValue: UInt64);
1418     procedure SetBlueMask (const aValue: UInt64);
1419     procedure SetAlphaMask(const aValue: UInt64);
1420
1421     procedure Update(aMask: UInt64; out aRange: Cardinal; out aShift: Byte);
1422   public
1423     property RedMask:   UInt64 read GetRedMask   write SetRedMask;
1424     property GreenMask: UInt64 read GetGreenMask write SetGreenMask;
1425     property BlueMask:  UInt64 read GetBlueMask  write SetBlueMask;
1426     property AlphaMask: UInt64 read GetAlphaMask write SetAlphaMask;
1427
1428     property PixelSize: Single read fPixelSize write fPixelSize;
1429
1430     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1431     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1432   end;
1433
1434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1435   TColorTableEnty = packed record
1436     b, g, r, a: Byte;
1437   end;
1438   TColorTable = array of TColorTableEnty;
1439   TColorTableFormat = class(TFormatDescriptor)
1440   private
1441     fColorTable: TColorTable;
1442   public
1443     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1444     property ColorTable: TColorTable       read fColorTable write fColorTable;
1445     property Range:      TglBitmapColorRec read fRange      write fRange;
1446
1447     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1448     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1449     destructor Destroy; override;
1450   end;
1451
1452 const
1453   LUMINANCE_WEIGHT_R = 0.30;
1454   LUMINANCE_WEIGHT_G = 0.59;
1455   LUMINANCE_WEIGHT_B = 0.11;
1456
1457   ALPHA_WEIGHT_R = 0.30;
1458   ALPHA_WEIGHT_G = 0.59;
1459   ALPHA_WEIGHT_B = 0.11;
1460
1461   DEPTH_WEIGHT_R = 0.333333333;
1462   DEPTH_WEIGHT_G = 0.333333333;
1463   DEPTH_WEIGHT_B = 0.333333333;
1464
1465   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1466
1467   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1468     TfdEmpty,
1469
1470     TfdAlpha4,
1471     TfdAlpha8,
1472     TfdAlpha12,
1473     TfdAlpha16,
1474
1475     TfdLuminance4,
1476     TfdLuminance8,
1477     TfdLuminance12,
1478     TfdLuminance16,
1479
1480     TfdLuminance4Alpha4,
1481     TfdLuminance6Alpha2,
1482     TfdLuminance8Alpha8,
1483     TfdLuminance12Alpha4,
1484     TfdLuminance12Alpha12,
1485     TfdLuminance16Alpha16,
1486
1487     TfdR3G3B2,
1488     TfdRGB4,
1489     TfdR5G6B5,
1490     TfdRGB5,
1491     TfdRGB8,
1492     TfdRGB10,
1493     TfdRGB12,
1494     TfdRGB16,
1495
1496     TfdRGBA2,
1497     TfdRGBA4,
1498     TfdRGB5A1,
1499     TfdRGBA8,
1500     TfdRGB10A2,
1501     TfdRGBA12,
1502     TfdRGBA16,
1503
1504     TfdBGR4,
1505     TfdB5G6R5,
1506     TfdBGR5,
1507     TfdBGR8,
1508     TfdBGR10,
1509     TfdBGR12,
1510     TfdBGR16,
1511
1512     TfdBGRA2,
1513     TfdBGRA4,
1514     TfdBGR5A1,
1515     TfdBGRA8,
1516     TfdBGR10A2,
1517     TfdBGRA12,
1518     TfdBGRA16,
1519
1520     TfdDepth16,
1521     TfdDepth24,
1522     TfdDepth32
1523   );
1524
1525 var
1526   FormatDescriptorCS: TCriticalSection;
1527   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1528
1529 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1530 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1531 begin
1532   result.Fields := [];
1533
1534   if X >= 0 then
1535     result.Fields := result.Fields + [ffX];
1536   if Y >= 0 then
1537     result.Fields := result.Fields + [ffY];
1538
1539   result.X := Max(0, X);
1540   result.Y := Max(0, Y);
1541 end;
1542
1543 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1544 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1545 begin
1546   result.r := r;
1547   result.g := g;
1548   result.b := b;
1549   result.a := a;
1550 end;
1551
1552 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1553 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1554 begin
1555   //TODO Supported File Formats!
1556   result := [ftDDS, ftTGA, ftBMP];
1557   (*
1558   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1559   if aFormat in [
1560     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1561     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1562     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1563     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1564     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1565     tfDepth16, tfDepth24, tfDepth32]
1566   then
1567     result := result + [ftPNG];
1568   {$ENDIF}
1569
1570   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1571   if Format in [
1572     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1573     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1574     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1575     tfDepth16, tfDepth24, tfDepth32]
1576   then
1577     result := result + [ftJPEG];
1578   {$ENDIF}
1579
1580   if aFormat in [
1581     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1582     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1583     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1584     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1585     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1586     tfDepth16, tfDepth24, tfDepth32]
1587   then
1588     result := result + [ftDDS, ftTGA, ftBMP];
1589   *)
1590 end;
1591
1592 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1593 function IsPowerOfTwo(aNumber: Integer): Boolean;
1594 begin
1595   while (aNumber and 1) = 0 do
1596     aNumber := aNumber shr 1;
1597   result := aNumber = 1;
1598 end;
1599
1600 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1601 function GetTopMostBit(aBitSet: UInt64): Integer;
1602 begin
1603   result := 0;
1604   while aBitSet > 0 do begin
1605     inc(result);
1606     aBitSet := aBitSet shr 1;
1607   end;
1608 end;
1609
1610 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1611 function CountSetBits(aBitSet: UInt64): Integer;
1612 begin
1613   result := 0;
1614   while aBitSet > 0 do begin
1615     if (aBitSet and 1) = 1 then
1616       inc(result);
1617     aBitSet := aBitSet shr 1;
1618   end;
1619 end;
1620
1621 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1622 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1623 begin
1624   result := Trunc(
1625     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1626     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1627     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1628 end;
1629
1630 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1631 begin
1632   result := Trunc(
1633     DEPTH_WEIGHT_R * aPixel.Data.r +
1634     DEPTH_WEIGHT_G * aPixel.Data.g +
1635     DEPTH_WEIGHT_B * aPixel.Data.b);
1636 end;
1637
1638 //TODO check _ARB functions and constants
1639
1640 (* GLB_NO_NATIVE_GL
1641 {$IFNDEF GLB_NO_NATIVE_GL}
1642 procedure ReadOpenGLExtensions;
1643 var
1644   {$IFDEF GLB_DELPHI}
1645   Context: HGLRC;
1646   {$ENDIF}
1647   Buffer: AnsiString;
1648   MajorVersion, MinorVersion: Integer;
1649
1650
1651   procedure TrimVersionString(Buffer: AnsiString; var Major, Minor: Integer);
1652   var
1653     Separator: Integer;
1654   begin
1655     Minor := 0;
1656     Major := 0;
1657
1658     Separator := Pos(AnsiString('.'), Buffer);
1659
1660     if (Separator > 1) and (Separator < Length(Buffer)) and
1661        (Buffer[Separator - 1] in ['0'..'9']) and
1662        (Buffer[Separator + 1] in ['0'..'9']) then begin
1663
1664       Dec(Separator);
1665       while (Separator > 0) and (Buffer[Separator] in ['0'..'9']) do
1666         Dec(Separator);
1667
1668       Delete(Buffer, 1, Separator);
1669       Separator := Pos(AnsiString('.'), Buffer) + 1;
1670
1671       while (Separator <= Length(Buffer)) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do
1672         Inc(Separator);
1673
1674       Delete(Buffer, Separator, 255);
1675       Separator := Pos(AnsiString('.'), Buffer);
1676
1677       Major := StrToInt(Copy(String(Buffer), 1, Separator - 1));
1678       Minor := StrToInt(Copy(String(Buffer), Separator + 1, 1));
1679     end;
1680   end;
1681
1682
1683   function CheckExtension(const Extension: AnsiString): Boolean;
1684   var
1685     ExtPos: Integer;
1686   begin
1687     ExtPos := Pos(Extension, Buffer);
1688     result := ExtPos > 0;
1689
1690     if result then
1691       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
1692   end;
1693
1694
1695   function glLoad (aFunc: pAnsiChar): pointer;
1696   begin
1697     {$IFDEF LINUX}
1698       result := glXGetProcAddress(aFunc);
1699     {$else}
1700       result := wglGetProcAddress(aFunc);
1701     {$ENDIF}
1702   end;
1703
1704
1705 begin
1706   {$IFDEF GLB_DELPHI}
1707   Context := wglGetCurrentContext;
1708
1709   if Context <> gLastContext then begin
1710     gLastContext := Context;
1711   {$ENDIF}
1712
1713     // Version
1714     Buffer := glGetString(GL_VERSION);
1715     TrimVersionString(Buffer, MajorVersion, MinorVersion);
1716
1717     GL_VERSION_1_2 := false;
1718     GL_VERSION_1_3 := false;
1719     GL_VERSION_1_4 := false;
1720     GL_VERSION_2_0 := false;
1721
1722     if MajorVersion = 1 then begin
1723       if MinorVersion >= 1 then begin
1724         if MinorVersion >= 2 then
1725           GL_VERSION_1_2 := true;
1726
1727         if MinorVersion >= 3 then
1728           GL_VERSION_1_3 := true;
1729
1730         if MinorVersion >= 4 then
1731           GL_VERSION_1_4 := true;
1732       end;
1733     end;
1734
1735     if MajorVersion >= 2 then begin
1736       GL_VERSION_1_2 := true;
1737       GL_VERSION_1_3 := true;
1738       GL_VERSION_1_4 := true;
1739       GL_VERSION_2_0 := true;
1740     end;
1741
1742     // Extensions
1743     Buffer := glGetString(GL_EXTENSIONS);
1744     GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
1745     GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
1746     GL_ARB_texture_compression        := CheckExtension('GL_ARB_texture_compression');
1747     GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
1748     GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
1749     GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
1750     GL_EXT_bgra                       := CheckExtension('GL_EXT_bgra');
1751     GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
1752     GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
1753     GL_EXT_texture_compression_s3tc   := CheckExtension('GL_EXT_texture_compression_s3tc');
1754     GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
1755     GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
1756     GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
1757     GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
1758     GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
1759
1760     // Funtions
1761     if GL_VERSION_1_3 then begin
1762       // Loading Core
1763       glCompressedTexImage1D := glLoad('glCompressedTexImage1D');
1764       glCompressedTexImage2D := glLoad('glCompressedTexImage2D');
1765       glGetCompressedTexImage := glLoad('glGetCompressedTexImage');
1766     end else
1767
1768     begin
1769       // Try loading Extension
1770       glCompressedTexImage1D := glLoad('glCompressedTexImage1DARB');
1771       glCompressedTexImage2D := glLoad('glCompressedTexImage2DARB');
1772       glGetCompressedTexImage := glLoad('glGetCompressedTexImageARB');
1773     end;
1774   {$IFDEF GLB_DELPHI}
1775   end;
1776   {$ENDIF}
1777 end;
1778 {$ENDIF}
1779 *)
1780
1781 (* TODO GLB_DELPHI
1782 {$IFDEF GLB_DELPHI}
1783 function CreateGrayPalette: HPALETTE;
1784 var
1785   Idx: Integer;
1786   Pal: PLogPalette;
1787 begin
1788   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
1789
1790   Pal.palVersion := $300;
1791   Pal.palNumEntries := 256;
1792
1793   {$IFOPT R+}
1794     {$DEFINE GLB_TEMPRANGECHECK}
1795     {$R-}
1796   {$ENDIF}
1797
1798   for Idx := 0 to 256 - 1 do begin
1799     Pal.palPalEntry[Idx].peRed   := Idx;
1800     Pal.palPalEntry[Idx].peGreen := Idx;
1801     Pal.palPalEntry[Idx].peBlue  := Idx;
1802     Pal.palPalEntry[Idx].peFlags := 0;
1803   end;
1804
1805   {$IFDEF GLB_TEMPRANGECHECK}
1806     {$UNDEF GLB_TEMPRANGECHECK}
1807     {$R+}
1808   {$ENDIF}
1809
1810   result := CreatePalette(Pal^);
1811
1812   FreeMem(Pal);
1813 end;
1814 {$ENDIF}
1815 *)
1816
1817 (* TODO GLB_SDL_IMAGE
1818 {$IFDEF GLB_SDL_IMAGE}
1819 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
1820 begin
1821   result := TStream(context^.unknown.data1).Seek(offset, whence);
1822 end;
1823
1824 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
1825 begin
1826   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
1827 end;
1828
1829 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
1830 begin
1831   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
1832 end;
1833
1834 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
1835 begin
1836   result := 0;
1837 end;
1838
1839 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
1840 begin
1841   result := SDL_AllocRW;
1842
1843   if result = nil then
1844     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
1845
1846   result^.seek := glBitmapRWseek;
1847   result^.read := glBitmapRWread;
1848   result^.write := glBitmapRWwrite;
1849   result^.close := glBitmapRWclose;
1850   result^.unknown.data1 := Stream;
1851 end;
1852 {$ENDIF}
1853 *)
1854
1855 (* TODO LoadFuncs
1856 function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
1857 var
1858   glBitmap: TglBitmap2D;
1859 begin
1860   result := false;
1861   Texture := 0;
1862
1863   {$IFDEF GLB_DELPHI}
1864   if Instance = 0 then
1865     Instance := HInstance;
1866
1867   if (LoadFromRes) then
1868     glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
1869   else
1870   {$ENDIF}
1871     glBitmap := TglBitmap2D.Create(FileName);
1872
1873   try
1874     glBitmap.DeleteTextureOnFree := false;
1875     glBitmap.FreeDataAfterGenTexture := false;
1876     glBitmap.GenTexture(true);
1877     if (glBitmap.ID > 0) then begin
1878       Texture := glBitmap.ID;
1879       result := true;
1880     end;
1881   finally
1882     glBitmap.Free;
1883   end;
1884 end;
1885
1886 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
1887 var
1888   CM: TglBitmapCubeMap;
1889 begin
1890   Texture := 0;
1891
1892   {$IFDEF GLB_DELPHI}
1893   if Instance = 0 then
1894     Instance := HInstance;
1895   {$ENDIF}
1896
1897   CM := TglBitmapCubeMap.Create;
1898   try
1899     CM.DeleteTextureOnFree := false;
1900
1901     // Maps
1902     {$IFDEF GLB_DELPHI}
1903     if (LoadFromRes) then
1904       CM.LoadFromResource(Instance, PositiveX)
1905     else
1906     {$ENDIF}
1907       CM.LoadFromFile(PositiveX);
1908     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
1909
1910     {$IFDEF GLB_DELPHI}
1911     if (LoadFromRes) then
1912       CM.LoadFromResource(Instance, NegativeX)
1913     else
1914     {$ENDIF}
1915       CM.LoadFromFile(NegativeX);
1916     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
1917
1918     {$IFDEF GLB_DELPHI}
1919     if (LoadFromRes) then
1920       CM.LoadFromResource(Instance, PositiveY)
1921     else
1922     {$ENDIF}
1923       CM.LoadFromFile(PositiveY);
1924     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
1925
1926     {$IFDEF GLB_DELPHI}
1927     if (LoadFromRes) then
1928       CM.LoadFromResource(Instance, NegativeY)
1929     else
1930     {$ENDIF}
1931       CM.LoadFromFile(NegativeY);
1932     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
1933
1934     {$IFDEF GLB_DELPHI}
1935     if (LoadFromRes) then
1936       CM.LoadFromResource(Instance, PositiveZ)
1937     else
1938     {$ENDIF}
1939       CM.LoadFromFile(PositiveZ);
1940     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
1941
1942     {$IFDEF GLB_DELPHI}
1943     if (LoadFromRes) then
1944       CM.LoadFromResource(Instance, NegativeZ)
1945     else
1946     {$ENDIF}
1947       CM.LoadFromFile(NegativeZ);
1948     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
1949
1950     Texture := CM.ID;
1951     result := true;
1952   finally
1953     CM.Free;
1954   end;
1955 end;
1956
1957 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
1958 var
1959   NM: TglBitmapNormalMap;
1960 begin
1961   Texture := 0;
1962
1963   NM := TglBitmapNormalMap.Create;
1964   try
1965     NM.DeleteTextureOnFree := false;
1966     NM.GenerateNormalMap(Size);
1967
1968     Texture := NM.ID;
1969     result := true;
1970   finally
1971     NM.Free;
1972   end;
1973 end;
1974 *)
1975
1976 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1977 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1978 begin
1979   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
1980 end;
1981
1982 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1983 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1984 begin
1985   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
1986 end;
1987
1988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1989 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1990 begin
1991   glBitmapDefaultMipmap := aValue;
1992 end;
1993
1994 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1995 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1996 begin
1997   glBitmapDefaultFormat := aFormat;
1998 end;
1999
2000 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2001 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2002 begin
2003   glBitmapDefaultFilterMin := aMin;
2004   glBitmapDefaultFilterMag := aMag;
2005 end;
2006
2007 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2008 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2009 begin
2010   glBitmapDefaultWrapS := S;
2011   glBitmapDefaultWrapT := T;
2012   glBitmapDefaultWrapR := R;
2013 end;
2014
2015 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2016 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2017 begin
2018   result := glBitmapDefaultDeleteTextureOnFree;
2019 end;
2020
2021 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2022 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2023 begin
2024   result := glBitmapDefaultFreeDataAfterGenTextures;
2025 end;
2026
2027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2028 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2029 begin
2030   result := glBitmapDefaultMipmap;
2031 end;
2032
2033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2034 function glBitmapGetDefaultFormat: TglBitmapFormat;
2035 begin
2036   result := glBitmapDefaultFormat;
2037 end;
2038
2039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2040 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2041 begin
2042   aMin := glBitmapDefaultFilterMin;
2043   aMag := glBitmapDefaultFilterMag;
2044 end;
2045
2046 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2047 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2048 begin
2049   S := glBitmapDefaultWrapS;
2050   T := glBitmapDefaultWrapT;
2051   R := glBitmapDefaultWrapR;
2052 end;
2053
2054 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2055 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2057 function TFormatDescriptor.GetRedMask: UInt64;
2058 begin
2059   result := fRange.r shl fShift.r;
2060 end;
2061
2062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2063 function TFormatDescriptor.GetGreenMask: UInt64;
2064 begin
2065   result := fRange.g shl fShift.g;
2066 end;
2067
2068 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2069 function TFormatDescriptor.GetBlueMask: UInt64;
2070 begin
2071   result := fRange.b shl fShift.b;
2072 end;
2073
2074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2075 function TFormatDescriptor.GetAlphaMask: UInt64;
2076 begin
2077   result := fRange.a shl fShift.a;
2078 end;
2079
2080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2081 function TFormatDescriptor.GetComponents: Integer;
2082 var
2083   i: Integer;
2084 begin
2085   result := 0;
2086   for i := 0 to 3 do
2087     if (fRange.arr[i] > 0) then
2088       inc(result);
2089 end;
2090
2091 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2092 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2093 var
2094   w, h: Integer;
2095 begin
2096   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2097     w := Max(1, aSize.X);
2098     h := Max(1, aSize.Y);
2099     result := GetSize(w, h);
2100   end else
2101     result := 0;
2102 end;
2103
2104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2105 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2106 begin
2107   result := 0;
2108   if (aWidth <= 0) or (aHeight <= 0) then
2109     exit;
2110   result := Ceil(aWidth * aHeight * fPixelSize);
2111 end;
2112
2113 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2114 function TFormatDescriptor.CreateMappingData: Pointer;
2115 begin
2116   result := nil;
2117 end;
2118
2119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2120 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2121 begin
2122   //DUMMY
2123 end;
2124
2125 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2126 function TFormatDescriptor.IsEmpty: Boolean;
2127 begin
2128   result := (fFormat = tfEmpty);
2129 end;
2130
2131 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2132 function TFormatDescriptor.HasAlpha: Boolean;
2133 begin
2134   result := (fRange.a > 0);
2135 end;
2136
2137 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2138 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean;
2139 begin
2140   result := false;
2141
2142   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2143     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2144
2145   if (aRedMask   <> RedMask) then
2146     exit;
2147   if (aGreenMask <> GreenMask) then
2148     exit;
2149   if (aBlueMask  <> BlueMask) then
2150     exit;
2151   if (aAlphaMask <> AlphaMask) then
2152     exit;
2153   result := true;
2154 end;
2155
2156 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2157 procedure TFormatDescriptor.PreparePixel(var aPixel: TglBitmapPixelData);
2158 begin
2159   FillChar(aPixel, SizeOf(aPixel), 0);
2160   aPixel.Data   := fRange;
2161   aPixel.Range  := fRange;
2162   aPixel.Format := fFormat;
2163 end;
2164
2165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2166 constructor TFormatDescriptor.Create;
2167 begin
2168   inherited Create;
2169
2170   fFormat       := tfEmpty;
2171   fWithAlpha    := tfEmpty;
2172   fWithoutAlpha := tfEmpty;
2173   fPixelSize    := 0.0;
2174
2175   fglFormat         := 0;
2176   fglInternalFormat := 0;
2177   fglDataFormat     := 0;
2178
2179   FillChar(fRange, 0, SizeOf(fRange));
2180   FillChar(fShift, 0, SizeOf(fShift));
2181 end;
2182
2183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2184 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2185 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2186 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2187 begin
2188   aData^ := aPixel.Data.a;
2189   inc(aData);
2190 end;
2191
2192 procedure TfdAlpha_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2193 begin
2194   aPixel.Data.r := 0;
2195   aPixel.Data.g := 0;
2196   aPixel.Data.b := 0;
2197   aPixel.Data.a := aData^;
2198   inc(aData^);
2199 end;
2200
2201 constructor TfdAlpha_UB1.Create;
2202 begin
2203   inherited Create;
2204   fPixelSize        := 1.0;
2205   fRange.a          := $FF;
2206   fglFormat         := GL_ALPHA;
2207   fglDataFormat     := GL_UNSIGNED_BYTE;
2208 end;
2209
2210 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2211 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2212 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2213 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2214 begin
2215   aData^ := LuminanceWeight(aPixel);
2216   inc(aData);
2217 end;
2218
2219 procedure TfdLuminance_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2220 begin
2221   aPixel.Data.r := aData^;
2222   aPixel.Data.g := aData^;
2223   aPixel.Data.b := aData^;
2224   aPixel.Data.a := 0;
2225   inc(aData);
2226 end;
2227
2228 constructor TfdLuminance_UB1.Create;
2229 begin
2230   inherited Create;
2231   fPixelSize        := 1.0;
2232   fRange.r          := $FF;
2233   fRange.g          := $FF;
2234   fRange.b          := $FF;
2235   fglFormat         := GL_LUMINANCE;
2236   fglDataFormat     := GL_UNSIGNED_BYTE;
2237 end;
2238
2239 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2240 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2241 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2242 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2243 var
2244   i: Integer;
2245 begin
2246   aData^ := 0;
2247   for i := 0 to 3 do
2248     if (fRange.arr[i] > 0) then
2249       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2250   inc(aData);
2251 end;
2252
2253 procedure TfdUniversal_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2254 var
2255   i: Integer;
2256 begin
2257   for i := 0 to 3 do
2258     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2259   inc(aData);
2260 end;
2261
2262 constructor TfdUniversal_UB1.Create;
2263 begin
2264   inherited Create;
2265   fPixelSize := 1.0;
2266 end;
2267
2268 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2269 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2271 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2272 begin
2273   inherited Map(aPixel, aData, aMapData);
2274   aData^ := aPixel.Data.a;
2275   inc(aData);
2276 end;
2277
2278 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2279 begin
2280   inherited Unmap(aData, aPixel, aMapData);
2281   aPixel.Data.a := aData^;
2282   inc(aData);
2283 end;
2284
2285 constructor TfdLuminanceAlpha_UB2.Create;
2286 begin
2287   inherited Create;
2288   fPixelSize        := 2.0;
2289   fRange.a          := $FF;
2290   fShift.a          :=   8;
2291   fglFormat         := GL_LUMINANCE_ALPHA;
2292   fglDataFormat     := GL_UNSIGNED_BYTE;
2293 end;
2294
2295 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2296 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2298 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2299 begin
2300   aData^ := aPixel.Data.r;
2301   inc(aData);
2302   aData^ := aPixel.Data.g;
2303   inc(aData);
2304   aData^ := aPixel.Data.b;
2305   inc(aData);
2306 end;
2307
2308 procedure TfdRGB_UB3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2309 begin
2310   aPixel.Data.r := aData^;
2311   inc(aData);
2312   aPixel.Data.g := aData^;
2313   inc(aData);
2314   aPixel.Data.b := aData^;
2315   inc(aData);
2316   aPixel.Data.a := 0;
2317 end;
2318
2319 constructor TfdRGB_UB3.Create;
2320 begin
2321   inherited Create;
2322   fPixelSize        := 3.0;
2323   fRange.r          := $FF;
2324   fRange.g          := $FF;
2325   fRange.b          := $FF;
2326   fShift.r          :=   0;
2327   fShift.g          :=   8;
2328   fShift.b          :=  16;
2329   fglFormat         := GL_RGB;
2330   fglDataFormat     := GL_UNSIGNED_BYTE;
2331 end;
2332
2333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2334 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2336 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2337 begin
2338   aData^ := aPixel.Data.b;
2339   inc(aData);
2340   aData^ := aPixel.Data.g;
2341   inc(aData);
2342   aData^ := aPixel.Data.r;
2343   inc(aData);
2344 end;
2345
2346 procedure TfdBGR_UB3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2347 begin
2348   aPixel.Data.b := aData^;
2349   inc(aData);
2350   aPixel.Data.g := aData^;
2351   inc(aData);
2352   aPixel.Data.r := aData^;
2353   inc(aData);
2354   aPixel.Data.a := 0;
2355 end;
2356
2357 constructor TfdBGR_UB3.Create;
2358 begin
2359   fPixelSize        := 3.0;
2360   fRange.r          := $FF;
2361   fRange.g          := $FF;
2362   fRange.b          := $FF;
2363   fShift.r          :=  16;
2364   fShift.g          :=   8;
2365   fShift.b          :=   0;
2366   fglFormat         := GL_BGR;
2367   fglDataFormat     := GL_UNSIGNED_BYTE;
2368 end;
2369
2370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2371 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2373 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2374 begin
2375   inherited Map(aPixel, aData, aMapData);
2376   aData^ := aPixel.Data.a;
2377   inc(aData);
2378 end;
2379
2380 procedure TfdRGBA_UB4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2381 begin
2382   inherited Unmap(aData, aPixel, aMapData);
2383   aPixel.Data.a := aData^;
2384   inc(aData);
2385 end;
2386
2387 constructor TfdRGBA_UB4.Create;
2388 begin
2389   inherited Create;
2390   fPixelSize        := 4.0;
2391   fRange.a          := $FF;
2392   fShift.a          :=  24;
2393   fglFormat         := GL_RGBA;
2394   fglDataFormat     := GL_UNSIGNED_BYTE;
2395 end;
2396
2397 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2398 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2400 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2401 begin
2402   inherited Map(aPixel, aData, aMapData);
2403   aData^ := aPixel.Data.a;
2404   inc(aData);
2405 end;
2406
2407 procedure TfdBGRA_UB4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2408 begin
2409   inherited Unmap(aData, aPixel, aMapData);
2410   aPixel.Data.a := aData^;
2411   inc(aData);
2412 end;
2413
2414 constructor TfdBGRA_UB4.Create;
2415 begin
2416   inherited Create;
2417   fPixelSize        := 4.0;
2418   fRange.a          := $FF;
2419   fShift.a          :=  24;
2420   fglFormat         := GL_BGRA;
2421   fglDataFormat     := GL_UNSIGNED_BYTE;
2422 end;
2423
2424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2425 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2427 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2428 begin
2429   PWord(aData)^ := aPixel.Data.a;
2430   inc(aData, 2);
2431 end;
2432
2433 procedure TfdAlpha_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2434 begin
2435   aPixel.Data.r := 0;
2436   aPixel.Data.g := 0;
2437   aPixel.Data.b := 0;
2438   aPixel.Data.a := PWord(aData)^;
2439   inc(aData, 2);
2440 end;
2441
2442 constructor TfdAlpha_US1.Create;
2443 begin
2444   inherited Create;
2445   fPixelSize        := 2.0;
2446   fRange.a          := $FFFF;
2447   fglFormat         := GL_ALPHA;
2448   fglDataFormat     := GL_UNSIGNED_SHORT;
2449 end;
2450
2451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2452 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2454 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2455 begin
2456   PWord(aData)^ := LuminanceWeight(aPixel);
2457   inc(aData, 2);
2458 end;
2459
2460 procedure TfdLuminance_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2461 begin
2462   aPixel.Data.r := PWord(aData)^;
2463   aPixel.Data.g := PWord(aData)^;
2464   aPixel.Data.b := PWord(aData)^;
2465   aPixel.Data.a := 0;
2466   inc(aData, 2);
2467 end;
2468
2469 constructor TfdLuminance_US1.Create;
2470 begin
2471   inherited Create;
2472   fPixelSize        := 2.0;
2473   fRange.r          := $FFFF;
2474   fRange.g          := $FFFF;
2475   fRange.b          := $FFFF;
2476   fglFormat         := GL_LUMINANCE;
2477   fglDataFormat     := GL_UNSIGNED_SHORT;
2478 end;
2479
2480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2481 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2483 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2484 var
2485   i: Integer;
2486 begin
2487   PWord(aData)^ := 0;
2488   for i := 0 to 3 do
2489     if (fRange.arr[i] > 0) then
2490       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2491   inc(aData, 2);
2492 end;
2493
2494 procedure TfdUniversal_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2495 var
2496   i: Integer;
2497 begin
2498   for i := 0 to 3 do
2499     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2500   inc(aData, 2);
2501 end;
2502
2503 constructor TfdUniversal_US1.Create;
2504 begin
2505   inherited Create;
2506   fPixelSize := 2.0;
2507 end;
2508
2509 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2510 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2511 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2512 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2513 begin
2514   PWord(aData)^ := DepthWeight(aPixel);
2515   inc(aData, 2);
2516 end;
2517
2518 procedure TfdDepth_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2519 begin
2520   aPixel.Data.r := PWord(aData)^;
2521   aPixel.Data.g := PWord(aData)^;
2522   aPixel.Data.b := PWord(aData)^;
2523   aPixel.Data.a := 0;
2524   inc(aData, 2);
2525 end;
2526
2527 constructor TfdDepth_US1.Create;
2528 begin
2529   inherited Create;
2530   fPixelSize        := 2.0;
2531   fRange.r          := $FFFF;
2532   fRange.g          := $FFFF;
2533   fRange.b          := $FFFF;
2534   fglFormat         := GL_DEPTH_COMPONENT;
2535   fglDataFormat     := GL_UNSIGNED_SHORT;
2536 end;
2537
2538 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2539 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2540 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2541 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2542 begin
2543   inherited Map(aPixel, aData, aMapData);
2544   PWord(aData)^ := aPixel.Data.a;
2545   inc(aData, 2);
2546 end;
2547
2548 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2549 begin
2550   inherited Unmap(aData, aPixel, aMapData);
2551   aPixel.Data.a := PWord(aData)^;
2552   inc(aData, 2);
2553 end;
2554
2555 constructor TfdLuminanceAlpha_US2.Create;
2556 begin
2557   inherited Create;
2558   fPixelSize        :=   4.0;
2559   fRange.a          := $FFFF;
2560   fShift.a          :=    16;
2561   fglFormat         := GL_LUMINANCE_ALPHA;
2562   fglDataFormat     := GL_UNSIGNED_SHORT;
2563 end;
2564
2565 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2566 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2567 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2568 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2569 begin
2570   PWord(aData)^ := aPixel.Data.r;
2571   inc(aData, 2);
2572   PWord(aData)^ := aPixel.Data.g;
2573   inc(aData, 2);
2574   PWord(aData)^ := aPixel.Data.b;
2575   inc(aData, 2);
2576 end;
2577
2578 procedure TfdRGB_US3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2579 begin
2580   aPixel.Data.r := PWord(aData)^;
2581   inc(aData, 2);
2582   aPixel.Data.g := PWord(aData)^;
2583   inc(aData, 2);
2584   aPixel.Data.b := PWord(aData)^;
2585   inc(aData, 2);
2586   aPixel.Data.a := 0;
2587 end;
2588
2589 constructor TfdRGB_US3.Create;
2590 begin
2591   inherited Create;
2592   fPixelSize        :=   6.0;
2593   fRange.r          := $FFFF;
2594   fRange.g          := $FFFF;
2595   fRange.b          := $FFFF;
2596   fShift.r          :=     0;
2597   fShift.g          :=    16;
2598   fShift.b          :=    32;
2599   fglFormat         := GL_RGB;
2600   fglDataFormat     := GL_UNSIGNED_SHORT;
2601 end;
2602
2603 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2604 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2605 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2606 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2607 begin
2608   PWord(aData)^ := aPixel.Data.b;
2609   inc(aData, 2);
2610   PWord(aData)^ := aPixel.Data.g;
2611   inc(aData, 2);
2612   PWord(aData)^ := aPixel.Data.r;
2613   inc(aData, 2);
2614 end;
2615
2616 procedure TfdBGR_US3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2617 begin
2618   aPixel.Data.b := PWord(aData)^;
2619   inc(aData, 2);
2620   aPixel.Data.g := PWord(aData)^;
2621   inc(aData, 2);
2622   aPixel.Data.r := PWord(aData)^;
2623   inc(aData, 2);
2624   aPixel.Data.a := 0;
2625 end;
2626
2627 constructor TfdBGR_US3.Create;
2628 begin
2629   inherited Create;
2630   fPixelSize        :=   6.0;
2631   fRange.r          := $FFFF;
2632   fRange.g          := $FFFF;
2633   fRange.b          := $FFFF;
2634   fShift.r          :=    32;
2635   fShift.g          :=    16;
2636   fShift.b          :=     0;
2637   fglFormat         := GL_BGR;
2638   fglDataFormat     := GL_UNSIGNED_SHORT;
2639 end;
2640
2641 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2642 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2644 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2645 begin
2646   inherited Map(aPixel, aData, aMapData);
2647   PWord(aData)^ := aPixel.Data.a;
2648   inc(aData, 2);
2649 end;
2650
2651 procedure TfdRGBA_US4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2652 begin
2653   inherited Unmap(aData, aPixel, aMapData);
2654   aPixel.Data.a := PWord(aData)^;
2655   inc(aData, 2);
2656 end;
2657
2658 constructor TfdRGBA_US4.Create;
2659 begin
2660   inherited Create;
2661   fPixelSize        :=   8.0;
2662   fRange.a          := $FFFF;
2663   fShift.a          :=    48;
2664   fglFormat         := GL_RGBA;
2665   fglDataFormat     := GL_UNSIGNED_SHORT;
2666 end;
2667
2668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2669 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2671 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2672 begin
2673   inherited Map(aPixel, aData, aMapData);
2674   PWord(aData)^ := aPixel.Data.a;
2675   inc(aData, 2);
2676 end;
2677
2678 procedure TfdBGRA_US4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2679 begin
2680   inherited Unmap(aData, aPixel, aMapData);
2681   aPixel.Data.a := PWord(aData)^;
2682   inc(aData, 2);
2683 end;
2684
2685 constructor TfdBGRA_US4.Create;
2686 begin
2687   inherited Create;
2688   fPixelSize        :=   8.0;
2689   fRange.a          := $FFFF;
2690   fShift.a          :=    48;
2691   fglFormat         := GL_BGRA;
2692   fglDataFormat     := GL_UNSIGNED_SHORT;
2693 end;
2694
2695 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2696 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2697 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2698 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2699 var
2700   i: Integer;
2701 begin
2702   PCardinal(aData)^ := 0;
2703   for i := 0 to 3 do
2704     if (fRange.arr[i] > 0) then
2705       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2706   inc(aData, 4);
2707 end;
2708
2709 procedure TfdUniversal_UI1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2710 var
2711   i: Integer;
2712 begin
2713   for i := 0 to 3 do
2714     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2715   inc(aData, 2);
2716 end;
2717
2718 constructor TfdUniversal_UI1.Create;
2719 begin
2720   inherited Create;
2721   fPixelSize := 4.0;
2722 end;
2723
2724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2725 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2727 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2728 begin
2729   PCardinal(aData)^ := DepthWeight(aPixel);
2730   inc(aData, 4);
2731 end;
2732
2733 procedure TfdDepth_UI1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
2734 begin
2735   aPixel.Data.r := PCardinal(aData)^;
2736   aPixel.Data.g := PCardinal(aData)^;
2737   aPixel.Data.b := PCardinal(aData)^;
2738   aPixel.Data.a := 0;
2739   inc(aData, 4);
2740 end;
2741
2742 constructor TfdDepth_UI1.Create;
2743 begin
2744   inherited Create;
2745   fPixelSize        := 4.0;
2746   fRange.r          := $FFFFFFFF;
2747   fRange.g          := $FFFFFFFF;
2748   fRange.b          := $FFFFFFFF;
2749   fglFormat         := GL_DEPTH_COMPONENT;
2750   fglDataFormat     := GL_UNSIGNED_INT;
2751 end;
2752
2753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2755 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2756 constructor TfdAlpha4.Create;
2757 begin
2758   inherited Create;
2759   fFormat           := tfAlpha4;
2760   fWithAlpha        := tfAlpha4;
2761   fglInternalFormat := GL_ALPHA4;
2762 end;
2763
2764 constructor TfdAlpha8.Create;
2765 begin
2766   inherited Create;
2767   fFormat           := tfAlpha8;
2768   fWithAlpha        := tfAlpha8;
2769   fglInternalFormat := GL_ALPHA8;
2770 end;
2771
2772 constructor TfdAlpha12.Create;
2773 begin
2774   inherited Create;
2775   fFormat           := tfAlpha12;
2776   fWithAlpha        := tfAlpha12;
2777   fglInternalFormat := GL_ALPHA12;
2778 end;
2779
2780 constructor TfdAlpha16.Create;
2781 begin
2782   inherited Create;
2783   fFormat           := tfAlpha16;
2784   fWithAlpha        := tfAlpha16;
2785   fglInternalFormat := GL_ALPHA16;
2786 end;
2787
2788 constructor TfdLuminance4.Create;
2789 begin
2790   inherited Create;
2791   fFormat           := tfLuminance4;
2792   fWithAlpha        := tfLuminance4Alpha4;
2793   fWithoutAlpha     := tfLuminance4;
2794   fglInternalFormat := GL_LUMINANCE4;
2795 end;
2796
2797 constructor TfdLuminance8.Create;
2798 begin
2799   inherited Create;
2800   fFormat           := tfLuminance8;
2801   fWithAlpha        := tfLuminance8Alpha8;
2802   fWithoutAlpha     := tfLuminance8;
2803   fglInternalFormat := GL_LUMINANCE8;
2804 end;
2805
2806 constructor TfdLuminance12.Create;
2807 begin
2808   inherited Create;
2809   fFormat           := tfLuminance12;
2810   fWithAlpha        := tfLuminance12Alpha12;
2811   fWithoutAlpha     := tfLuminance12;
2812   fglInternalFormat := GL_LUMINANCE12;
2813 end;
2814
2815 constructor TfdLuminance16.Create;
2816 begin
2817   inherited Create;
2818   fFormat           := tfLuminance16;
2819   fWithAlpha        := tfLuminance16Alpha16;
2820   fWithoutAlpha     := tfLuminance16;
2821   fglInternalFormat := GL_LUMINANCE16;
2822 end;
2823
2824 constructor TfdLuminance4Alpha4.Create;
2825 begin
2826   inherited Create;
2827   fFormat           := tfLuminance4Alpha4;
2828   fWithAlpha        := tfLuminance4Alpha4;
2829   fWithoutAlpha     := tfLuminance4;
2830   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
2831 end;
2832
2833 constructor TfdLuminance6Alpha2.Create;
2834 begin
2835   inherited Create;
2836   fFormat           := tfLuminance6Alpha2;
2837   fWithAlpha        := tfLuminance6Alpha2;
2838   fWithoutAlpha     := tfLuminance8;
2839   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
2840 end;
2841
2842 constructor TfdLuminance8Alpha8.Create;
2843 begin
2844   inherited Create;
2845   fFormat           := tfLuminance8Alpha8;
2846   fWithAlpha        := tfLuminance8Alpha8;
2847   fWithoutAlpha     := tfLuminance8;
2848   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
2849 end;
2850
2851 constructor TfdLuminance12Alpha4.Create;
2852 begin
2853   inherited Create;
2854   fFormat           := tfLuminance12Alpha4;
2855   fWithAlpha        := tfLuminance12Alpha4;
2856   fWithoutAlpha     := tfLuminance12;
2857   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
2858 end;
2859
2860 constructor TfdLuminance12Alpha12.Create;
2861 begin
2862   inherited Create;
2863   fFormat           := tfLuminance12Alpha12;
2864   fWithAlpha        := tfLuminance12Alpha12;
2865   fWithoutAlpha     := tfLuminance12;
2866   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
2867 end;
2868
2869 constructor TfdLuminance16Alpha16.Create;
2870 begin
2871   inherited Create;
2872   fFormat           := tfLuminance16Alpha16;
2873   fWithAlpha        := tfLuminance16Alpha16;
2874   fWithoutAlpha     := tfLuminance16;
2875   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
2876 end;
2877
2878 constructor TfdR3G3B2.Create;
2879 begin
2880   inherited Create;
2881   fFormat           := tfR3G3B2;
2882   fWithAlpha        := tfRGBA2;
2883   fWithoutAlpha     := tfR3G3B2;
2884   fRange.r          := $7;
2885   fRange.g          := $7;
2886   fRange.b          := $3;
2887   fShift.r          :=  0;
2888   fShift.g          :=  3;
2889   fShift.b          :=  6;
2890   fglFormat         := GL_RGB;
2891   fglInternalFormat := GL_R3_G3_B2;
2892   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
2893 end;
2894
2895 constructor TfdRGB4.Create;
2896 begin
2897   inherited Create;
2898   fFormat           := tfRGB4;
2899   fWithAlpha        := tfRGBA4;
2900   fWithoutAlpha     := tfRGB4;
2901   fRange.r          := $F;
2902   fRange.g          := $F;
2903   fRange.b          := $F;
2904   fShift.r          :=  0;
2905   fShift.g          :=  4;
2906   fShift.b          :=  8;
2907   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2908   fglInternalFormat := GL_RGB4;
2909   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
2910 end;
2911
2912 constructor TfdR5G6B5.Create;
2913 begin
2914   inherited Create;
2915   fFormat           := tfR5G6B5;
2916   fWithAlpha        := tfRGBA4;
2917   fWithoutAlpha     := tfR5G6B5;
2918   fRange.r          := $1F;
2919   fRange.g          := $3F;
2920   fRange.b          := $1F;
2921   fShift.r          :=   0;
2922   fShift.g          :=   5;
2923   fShift.b          :=  11;
2924   fglFormat         := GL_RGB;
2925   fglInternalFormat := GL_RGB565;
2926   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
2927 end;
2928
2929 constructor TfdRGB5.Create;
2930 begin
2931   inherited Create;
2932   fFormat           := tfRGB5;
2933   fWithAlpha        := tfRGB5A1;
2934   fWithoutAlpha     := tfRGB5;
2935   fRange.r          := $1F;
2936   fRange.g          := $1F;
2937   fRange.b          := $1F;
2938   fShift.r          :=   0;
2939   fShift.g          :=   5;
2940   fShift.b          :=  10;
2941   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2942   fglInternalFormat := GL_RGB5;
2943   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
2944 end;
2945
2946 constructor TfdRGB8.Create;
2947 begin
2948   inherited Create;
2949   fFormat           := tfRGB8;
2950   fWithAlpha        := tfRGBA8;
2951   fWithoutAlpha     := tfRGB8;
2952   fglInternalFormat := GL_RGB8;
2953 end;
2954
2955 constructor TfdRGB10.Create;
2956 begin
2957   inherited Create;
2958   fFormat           := tfRGB10;
2959   fWithAlpha        := tfRGB10A2;
2960   fWithoutAlpha     := tfRGB10;
2961   fRange.r          := $3FF;
2962   fRange.g          := $3FF;
2963   fRange.b          := $3FF;
2964   fShift.r          :=    0;
2965   fShift.g          :=   10;
2966   fShift.b          :=   20;
2967   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2968   fglInternalFormat := GL_RGB10;
2969   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
2970 end;
2971
2972 constructor TfdRGB12.Create;
2973 begin
2974   inherited Create;
2975   fFormat           := tfRGB12;
2976   fWithAlpha        := tfRGBA12;
2977   fWithoutAlpha     := tfRGB12;
2978   fglInternalFormat := GL_RGB12;
2979 end;
2980
2981 constructor TfdRGB16.Create;
2982 begin
2983   inherited Create;
2984   fFormat           := tfRGB16;
2985   fWithAlpha        := tfRGBA16;
2986   fWithoutAlpha     := tfRGB16;
2987   fglInternalFormat := GL_RGB16;
2988 end;
2989
2990 constructor TfdRGBA2.Create;
2991 begin
2992   inherited Create;
2993   fFormat           := tfRGBA2;
2994   fWithAlpha        := tfRGBA2;
2995   fWithoutAlpha     := tfR3G3B2;
2996   fglInternalFormat := GL_RGBA2;
2997 end;
2998
2999 constructor TfdRGBA4.Create;
3000 begin
3001   inherited Create;
3002   fFormat           := tfRGBA4;
3003   fWithAlpha        := tfRGBA4;
3004   fWithoutAlpha     := tfRGB4;
3005   fRange.r          := $F;
3006   fRange.g          := $F;
3007   fRange.b          := $F;
3008   fRange.a          := $F;
3009   fShift.r          :=  0;
3010   fShift.g          :=  4;
3011   fShift.b          :=  8;
3012   fShift.a          := 12;
3013   fglFormat         := GL_RGBA;
3014   fglInternalFormat := GL_RGBA4;
3015   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3016 end;
3017
3018 constructor TfdRGB5A1.Create;
3019 begin
3020   inherited Create;
3021   fFormat           := tfRGB5A1;
3022   fWithAlpha        := tfRGB5A1;
3023   fWithoutAlpha     := tfRGB5;
3024   fRange.r          := $1F;
3025   fRange.g          := $1F;
3026   fRange.b          := $1F;
3027   fRange.a          := $01;
3028   fShift.r          :=   0;
3029   fShift.g          :=   5;
3030   fShift.b          :=  10;
3031   fShift.a          :=  15;
3032   fglFormat         := GL_RGBA;
3033   fglInternalFormat := GL_RGB5_A1;
3034   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3035 end;
3036
3037 constructor TfdRGBA8.Create;
3038 begin
3039   inherited Create;
3040   fFormat           := tfRGBA8;
3041   fWithAlpha        := tfRGBA8;
3042   fWithoutAlpha     := tfRGB8;
3043   fglInternalFormat := GL_RGBA8;
3044 end;
3045
3046 constructor TfdRGB10A2.Create;
3047 begin
3048   inherited Create;
3049   fFormat           := tfRGB10A2;
3050   fWithAlpha        := tfRGB10A2;
3051   fWithoutAlpha     := tfRGB10;
3052   fRange.r          := $3FF;
3053   fRange.g          := $3FF;
3054   fRange.b          := $3FF;
3055   fRange.a          := $003;
3056   fShift.r          :=    0;
3057   fShift.g          :=   10;
3058   fShift.b          :=   20;
3059   fShift.a          :=   30;
3060   fglFormat         := GL_RGBA;
3061   fglInternalFormat := GL_RGB10_A2;
3062   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3063 end;
3064
3065 constructor TfdRGBA12.Create;
3066 begin
3067   inherited Create;
3068   fFormat           := tfRGBA12;
3069   fWithAlpha        := tfRGBA12;
3070   fWithoutAlpha     := tfRGB12;
3071   fglInternalFormat := GL_RGBA12;
3072 end;
3073
3074 constructor TfdRGBA16.Create;
3075 begin
3076   inherited Create;
3077   fFormat           := tfRGBA16;
3078   fWithAlpha        := tfRGBA16;
3079   fWithoutAlpha     := tfRGB16;
3080   fglInternalFormat := GL_RGBA16;
3081 end;
3082
3083 constructor TfdBGR4.Create;
3084 begin
3085   inherited Create;
3086   fPixelSize        := 2.0;
3087   fFormat           := tfBGR4;
3088   fWithAlpha        := tfBGRA4;
3089   fWithoutAlpha     := tfBGR4;
3090   fRange.r          := $F;
3091   fRange.g          := $F;
3092   fRange.b          := $F;
3093   fRange.a          := $0;
3094   fShift.r          :=  8;
3095   fShift.g          :=  4;
3096   fShift.b          :=  0;
3097   fShift.a          :=  0;
3098   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3099   fglInternalFormat := GL_RGB4;
3100   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3101 end;
3102
3103 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3105 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3106 constructor TfdB5G6R5.Create;
3107 begin
3108   inherited Create;
3109   fFormat           := tfB5G6R5;
3110   fWithAlpha        := tfBGRA4;
3111   fWithoutAlpha     := tfB5G6R5;
3112   fRange.r          := $1F;
3113   fRange.g          := $3F;
3114   fRange.b          := $1F;
3115   fShift.r          :=  11;
3116   fShift.g          :=   5;
3117   fShift.b          :=   0;
3118   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3119   fglInternalFormat := GL_RGB8;
3120   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3121 end;
3122
3123 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3124 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3125 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3126 constructor TfdBGR5.Create;
3127 begin
3128   inherited Create;
3129   fPixelSize        := 2.0;
3130   fFormat           := tfBGR5;
3131   fWithAlpha        := tfBGR5A1;
3132   fWithoutAlpha     := tfBGR5;
3133   fRange.r          := $1F;
3134   fRange.g          := $1F;
3135   fRange.b          := $1F;
3136   fRange.a          := $00;
3137   fShift.r          :=  10;
3138   fShift.g          :=   5;
3139   fShift.b          :=   0;
3140   fShift.a          :=   0;
3141   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3142   fglInternalFormat := GL_RGB5;
3143   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3144 end;
3145
3146 constructor TfdBGR8.Create;
3147 begin
3148   inherited Create;
3149   fFormat           := tfBGR8;
3150   fWithAlpha        := tfBGRA8;
3151   fWithoutAlpha     := tfBGR8;
3152   fglInternalFormat := GL_RGB8;
3153 end;
3154
3155 constructor TfdBGR10.Create;
3156 begin
3157   inherited Create;
3158   fFormat           := tfBGR10;
3159   fWithAlpha        := tfBGR10A2;
3160   fWithoutAlpha     := tfBGR10;
3161   fRange.r          := $3FF;
3162   fRange.g          := $3FF;
3163   fRange.b          := $3FF;
3164   fRange.a          := $000;
3165   fShift.r          :=   20;
3166   fShift.g          :=   10;
3167   fShift.b          :=    0;
3168   fShift.a          :=    0;
3169   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3170   fglInternalFormat := GL_RGB10;
3171   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3172 end;
3173
3174 constructor TfdBGR12.Create;
3175 begin
3176   inherited Create;
3177   fFormat           := tfBGR12;
3178   fWithAlpha        := tfBGRA12;
3179   fWithoutAlpha     := tfBGR12;
3180   fglInternalFormat := GL_RGB12;
3181 end;
3182
3183 constructor TfdBGR16.Create;
3184 begin
3185   inherited Create;
3186   fFormat           := tfBGR16;
3187   fWithAlpha        := tfBGRA16;
3188   fWithoutAlpha     := tfBGR16;
3189   fglInternalFormat := GL_RGB16;
3190 end;
3191
3192 constructor TfdBGRA2.Create;
3193 begin
3194   inherited Create;
3195   fFormat           := tfBGRA2;
3196   fWithAlpha        := tfBGRA4;
3197   fWithoutAlpha     := tfBGR4;
3198   fglInternalFormat := GL_RGBA2;
3199 end;
3200
3201 constructor TfdBGRA4.Create;
3202 begin
3203   inherited Create;
3204   fFormat           := tfBGRA4;
3205   fWithAlpha        := tfBGRA4;
3206   fWithoutAlpha     := tfBGR4;
3207   fRange.r          := $F;
3208   fRange.g          := $F;
3209   fRange.b          := $F;
3210   fRange.a          := $F;
3211   fShift.r          :=  8;
3212   fShift.g          :=  4;
3213   fShift.b          :=  0;
3214   fShift.a          := 12;
3215   fglFormat         := GL_BGRA;
3216   fglInternalFormat := GL_RGBA4;
3217   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3218 end;
3219
3220 constructor TfdBGR5A1.Create;
3221 begin
3222   inherited Create;
3223   fFormat           := tfBGR5A1;
3224   fWithAlpha        := tfBGR5A1;
3225   fWithoutAlpha     := tfBGR5;
3226   fRange.r          := $1F;
3227   fRange.g          := $1F;
3228   fRange.b          := $1F;
3229   fRange.a          := $01;
3230   fShift.r          :=  10;
3231   fShift.g          :=   5;
3232   fShift.b          :=   0;
3233   fShift.a          :=  15;
3234   fglFormat         := GL_BGRA;
3235   fglInternalFormat := GL_RGB5_A1;
3236   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3237 end;
3238
3239 constructor TfdBGRA8.Create;
3240 begin
3241   inherited Create;
3242   fFormat           := tfBGRA8;
3243   fWithAlpha        := tfBGRA8;
3244   fWithoutAlpha     := tfBGR8;
3245   fglInternalFormat := GL_RGBA8;
3246 end;
3247
3248 constructor TfdBGR10A2.Create;
3249 begin
3250   inherited Create;
3251   fFormat           := tfBGR10A2;
3252   fWithAlpha        := tfBGR10A2;
3253   fWithoutAlpha     := tfBGR10;
3254   fRange.r          := $3FF;
3255   fRange.g          := $3FF;
3256   fRange.b          := $3FF;
3257   fRange.a          := $003;
3258   fShift.r          :=   20;
3259   fShift.g          :=   10;
3260   fShift.b          :=    0;
3261   fShift.a          :=   30;
3262   fglFormat         := GL_BGRA;
3263   fglInternalFormat := GL_RGB10_A2;
3264   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3265 end;
3266
3267 constructor TfdBGRA12.Create;
3268 begin
3269   inherited Create;
3270   fFormat           := tfBGRA12;
3271   fWithAlpha        := tfBGRA12;
3272   fWithoutAlpha     := tfBGR12;
3273   fglInternalFormat := GL_RGBA12;
3274 end;
3275
3276 constructor TfdBGRA16.Create;
3277 begin
3278   inherited Create;
3279   fFormat           := tfBGRA16;
3280   fWithAlpha        := tfBGRA16;
3281   fWithoutAlpha     := tfBGR16;
3282   fglInternalFormat := GL_RGBA16;
3283 end;
3284
3285 constructor TfdDepth16.Create;
3286 begin
3287   inherited Create;
3288   fFormat           := tfDepth16;
3289   fWithAlpha        := tfEmpty;
3290   fWithoutAlpha     := tfDepth16;
3291   fglInternalFormat := GL_DEPTH_COMPONENT16;
3292 end;
3293
3294 constructor TfdDepth24.Create;
3295 begin
3296   inherited Create;
3297   fFormat           := tfDepth24;
3298   fWithAlpha        := tfEmpty;
3299   fWithoutAlpha     := tfDepth24;
3300   fglInternalFormat := GL_DEPTH_COMPONENT24;
3301 end;
3302
3303 constructor TfdDepth32.Create;
3304 begin
3305   inherited Create;
3306   fFormat           := tfDepth32;
3307   fWithAlpha        := tfEmpty;
3308   fWithoutAlpha     := tfDepth32;
3309   fglInternalFormat := GL_DEPTH_COMPONENT32;
3310 end;
3311
3312 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3313 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3314 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3315 class procedure TFormatDescriptor.Init;
3316 begin
3317   if not Assigned(FormatDescriptorCS) then
3318     FormatDescriptorCS := TCriticalSection.Create;
3319 end;
3320
3321 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3322 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3323 begin
3324   FormatDescriptorCS.Enter;
3325   try
3326     result := FormatDescriptors[aFormat];
3327     if not Assigned(result) then begin
3328       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3329       FormatDescriptors[aFormat] := result;
3330     end;
3331   finally
3332     FormatDescriptorCS.Leave;
3333   end;
3334 end;
3335
3336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3337 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3338 begin
3339   result := Get(Get(aFormat).WithAlpha);
3340 end;
3341
3342 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3343 class procedure TFormatDescriptor.Clear;
3344 var
3345   f: TglBitmapFormat;
3346 begin
3347   FormatDescriptorCS.Enter;
3348   try
3349     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3350       FreeAndNil(FormatDescriptors[f]);
3351   finally
3352     FormatDescriptorCS.Leave;
3353   end;
3354 end;
3355
3356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3357 class procedure TFormatDescriptor.Finalize;
3358 begin
3359   Clear;
3360   FreeAndNil(FormatDescriptorCS);
3361 end;
3362
3363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3364 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3366 procedure TBitfieldFormat.SetRedMask(const aValue: UInt64);
3367 begin
3368   Update(aValue, fRange.r, fShift.r);
3369 end;
3370
3371 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3372 procedure TBitfieldFormat.SetGreenMask(const aValue: UInt64);
3373 begin
3374   Update(aValue, fRange.g, fShift.g);
3375 end;
3376
3377 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3378 procedure TBitfieldFormat.SetBlueMask(const aValue: UInt64);
3379 begin
3380   Update(aValue, fRange.b, fShift.b);
3381 end;
3382
3383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3384 procedure TBitfieldFormat.SetAlphaMask(const aValue: UInt64);
3385 begin
3386   Update(aValue, fRange.a, fShift.a);
3387 end;
3388
3389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3390 procedure TBitfieldFormat.Update(aMask: UInt64; out aRange: Cardinal; out
3391   aShift: Byte);
3392 begin
3393   aShift := 0;
3394   aRange := 0;
3395   if (aMask = 0) then
3396     exit;
3397   while (aMask > 0) and ((aMask and 1) = 0) do begin
3398     inc(aShift);
3399     aMask := aMask shr 1;
3400   end;
3401   aRange := 1;
3402   while (aMask > 0) do begin
3403     aRange := aRange shl 1;
3404     aMask  := aMask  shr 1;
3405   end;
3406   dec(aRange);
3407
3408   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3409 end;
3410
3411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3412 procedure TBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3413 var
3414   data: UInt64;
3415   s: Integer;
3416 type
3417   PUInt64 = ^UInt64;
3418 begin
3419   data :=
3420     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3421     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3422     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3423     ((aPixel.Data.a and fRange.a) shl fShift.a);
3424   s := Round(fPixelSize);
3425   case s of
3426     1:           aData^  := data;
3427     2:     PWord(aData)^ := data;
3428     4: PCardinal(aData)^ := data;
3429     8:   PUInt64(aData)^ := data;
3430   else
3431     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3432   end;
3433   inc(aData, s);
3434 end;
3435
3436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3437 procedure TBitfieldFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
3438 var
3439   data: UInt64;
3440   s, i: Integer;
3441 type
3442   PUInt64 = ^UInt64;
3443 begin
3444   s := Round(fPixelSize);
3445   case s of
3446     1: data :=           aData^;
3447     2: data :=     PWord(aData)^;
3448     4: data := PCardinal(aData)^;
3449     8: data :=   PUInt64(aData)^;
3450   else
3451     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3452   end;
3453   for i := 0 to 3 do
3454     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3455   inc(aData, s);
3456 end;
3457
3458 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3459 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3461 procedure TColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3462 begin
3463   raise EglBitmapException.Create('mapping of color table formats is not supported');
3464 end;
3465
3466 procedure TColorTableFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
3467 type
3468   PUInt64 = ^UInt64;
3469 var
3470   idx: UInt64;
3471   s: Integer;
3472   bits: Byte;
3473   f: Single;
3474 begin
3475   s    := Trunc(fPixelSize);
3476   f    := fPixelSize - s;
3477   bits := Round(8 * f);
3478   case s of
3479     0: idx :=          (aData^ shr (8 - bits - PtrInt(aMapData))) and ((1 shl bits) - 1);
3480     1: idx :=           aData^;
3481     2: idx :=     PWord(aData)^;
3482     4: idx := PCardinal(aData)^;
3483     8: idx :=   PUInt64(aData)^;
3484   else
3485     raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3486   end;
3487   if (idx >= Length(fColorTable)) then
3488     raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
3489   with fColorTable[idx] do begin
3490     aPixel.Data.r := r;
3491     aPixel.Data.g := g;
3492     aPixel.Data.b := b;
3493     aPixel.Data.a := a;
3494   end;
3495   inc(aMapData, bits);
3496   if (PtrInt(aMapData) >= 8) then begin
3497     inc(aData, 1);
3498     dec(aMapData, 8);
3499   end;
3500   inc(aData, s);
3501 end;
3502
3503 destructor TColorTableFormat.Destroy;
3504 begin
3505   SetLength(fColorTable, 0);
3506   inherited Destroy;
3507 end;
3508
3509 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3510 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3511 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3512 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3513 begin
3514   with aFuncRec do begin
3515     if (Source.Range.r   > 0) then
3516       Dest.Data.r := Source.Data.r;
3517     if (Source.Range.g > 0) then
3518       Dest.Data.g := Source.Data.g;
3519     if (Source.Range.b  > 0) then
3520       Dest.Data.b := Source.Data.b;
3521     if (Source.Range.a > 0) then
3522       Dest.Data.a := Source.Data.a;
3523   end;
3524 end;
3525
3526 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3527 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3528 var
3529   i: Integer;
3530 begin
3531   with aFuncRec do begin
3532     for i := 0 to 3 do
3533       if (Source.Range.arr[i] > 0) then
3534         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
3535   end;
3536 end;
3537
3538 type
3539   TShiftData = packed record
3540     case Integer of
3541       0: (r, g, b, a: SmallInt);
3542       1: (arr: array[0..3] of SmallInt);
3543   end;
3544   PShiftData = ^TShiftData;
3545
3546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3547 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3548 var
3549   i: Integer;
3550 begin
3551   with aFuncRec do
3552     for i := 0 to 3 do
3553       if (Source.Range.arr[i] > 0) then
3554         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
3555 end;
3556
3557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3558 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
3559 begin
3560   with aFuncRec do begin
3561     Dest.Data.r := Source.Data.r;
3562     Dest.Data.g := Source.Data.g;
3563     Dest.Data.b := Source.Data.b;
3564     Dest.Data.a := Source.Data.a;
3565     if (Args and $1 > 0) then begin
3566       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
3567       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
3568       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
3569     end;
3570     if (Args and $2 > 0) then begin
3571       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
3572     end;
3573   end;
3574 end;
3575
3576 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3577 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
3578 var
3579   i: Integer;
3580 begin
3581   with aFuncRec do begin
3582     for i := 0 to 3 do
3583       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
3584   end;
3585 end;
3586
3587 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3588 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3589 var
3590   Temp: Single;
3591 begin
3592   with FuncRec do begin
3593     if (FuncRec.Args = 0) then begin //source has no alpha
3594       Temp :=
3595         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
3596         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
3597         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
3598       Dest.Data.a := Round(Dest.Range.a * Temp);
3599     end else
3600       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
3601   end;
3602 end;
3603
3604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3605 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3606 type
3607   PglBitmapPixelData = ^TglBitmapPixelData;
3608 begin
3609   with FuncRec do begin
3610     Dest.Data.r := Source.Data.r;
3611     Dest.Data.g := Source.Data.g;
3612     Dest.Data.b := Source.Data.b;
3613
3614     with PglBitmapPixelData(Args)^ do
3615       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
3616           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
3617           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
3618         Dest.Data.a := 0
3619       else
3620         Dest.Data.a := Dest.Range.a;
3621   end;
3622 end;
3623
3624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3625 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3626 type
3627   PglBitmapPixelData = ^TglBitmapPixelData;
3628 begin
3629   with FuncRec do begin
3630     Dest.Data.r := Source.Data.r;
3631     Dest.Data.g := Source.Data.g;
3632     Dest.Data.b := Source.Data.b;
3633     Dest.Data.a := PCardinal(Args)^;
3634   end;
3635 end;
3636
3637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3638 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
3639 type
3640   PRGBPix = ^TRGBPix;
3641   TRGBPix = array [0..2] of byte;
3642 var
3643   Temp: Byte;
3644 begin
3645   while aWidth > 0 do begin
3646     Temp := PRGBPix(aData)^[0];
3647     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
3648     PRGBPix(aData)^[2] := Temp;
3649
3650     if aHasAlpha then
3651       Inc(aData, 4)
3652     else
3653       Inc(aData, 3);
3654     dec(aWidth);
3655   end;
3656 end;
3657
3658 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3659 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3660 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3661 function TglBitmap.GetWidth: Integer;
3662 begin
3663   if (ffX in fDimension.Fields) then
3664     result := fDimension.X
3665   else
3666     result := -1;
3667 end;
3668
3669 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3670 function TglBitmap.GetHeight: Integer;
3671 begin
3672   if (ffY in fDimension.Fields) then
3673     result := fDimension.Y
3674   else
3675     result := -1;
3676 end;
3677
3678 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3679 function TglBitmap.GetFileWidth: Integer;
3680 begin
3681   result := Max(1, Width);
3682 end;
3683
3684 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3685 function TglBitmap.GetFileHeight: Integer;
3686 begin
3687   result := Max(1, Height);
3688 end;
3689
3690 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3691 procedure TglBitmap.SetCustomData(const aValue: Pointer);
3692 begin
3693   if fCustomData = aValue then
3694     exit;
3695   fCustomData := aValue;
3696 end;
3697
3698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3699 procedure TglBitmap.SetCustomName(const aValue: String);
3700 begin
3701   if fCustomName = aValue then
3702     exit;
3703   fCustomName := aValue;
3704 end;
3705
3706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3707 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
3708 begin
3709   if fCustomNameW = aValue then
3710     exit;
3711   fCustomNameW := aValue;
3712 end;
3713
3714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3715 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
3716 begin
3717   if fDeleteTextureOnFree = aValue then
3718     exit;
3719   fDeleteTextureOnFree := aValue;
3720 end;
3721
3722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3723 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
3724 begin
3725   if fFormat = aValue then
3726     exit;
3727   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
3728     raise EglBitmapUnsupportedFormatFormat.Create('SetInternalFormat - ' + UNSUPPORTED_FORMAT);
3729   SetDataPointer(Data, aValue, Width, Height);
3730 end;
3731
3732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3733 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
3734 begin
3735   if fFreeDataAfterGenTexture = aValue then
3736     exit;
3737   fFreeDataAfterGenTexture := aValue;
3738 end;
3739
3740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3741 procedure TglBitmap.SetID(const aValue: Cardinal);
3742 begin
3743   if fID = aValue then
3744     exit;
3745   fID := aValue;
3746 end;
3747
3748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3749 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
3750 begin
3751   if fMipMap = aValue then
3752     exit;
3753   fMipMap := aValue;
3754 end;
3755
3756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3757 procedure TglBitmap.SetTarget(const aValue: Cardinal);
3758 begin
3759   if fTarget = aValue then
3760     exit;
3761   fTarget := aValue;
3762 end;
3763
3764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3765 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
3766 var
3767   MaxAnisotropic: Integer;
3768 begin
3769   fAnisotropic := aValue;
3770   if (ID > 0) then begin
3771     if GL_EXT_texture_filter_anisotropic then begin
3772       if fAnisotropic > 0 then begin
3773         Bind(false);
3774         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
3775         if aValue > MaxAnisotropic then
3776           fAnisotropic := MaxAnisotropic;
3777         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
3778       end;
3779     end else begin
3780       fAnisotropic := 0;
3781     end;
3782   end;
3783 end;
3784
3785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3786 procedure TglBitmap.CreateID;
3787 begin
3788   if (ID <> 0) then
3789     glDeleteTextures(1, @fID);
3790   glGenTextures(1, @fID);
3791   Bind(false);
3792 end;
3793
3794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3795 procedure TglBitmap.SetupParameters(var aBuildWithGlu: Boolean);
3796 begin
3797   // Set Up Parameters
3798   SetWrap(fWrapS, fWrapT, fWrapR);
3799   SetFilter(fFilterMin, fFilterMag);
3800   SetAnisotropic(fAnisotropic);
3801   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
3802
3803   // Mip Maps Generation Mode
3804   aBuildWithGlu := false;
3805   if (MipMap = mmMipmap) then begin
3806     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
3807       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
3808     else
3809       aBuildWithGlu := true;
3810   end else if (MipMap = mmMipmapGlu) then
3811     aBuildWithGlu := true;
3812 end;
3813
3814 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3815 procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
3816   const aWidth: Integer; const aHeight: Integer);
3817 var
3818   s: Single;
3819 begin
3820   if (Data <> aData) then begin
3821     if (Assigned(Data)) then
3822       FreeMem(Data);
3823     fData := aData;
3824   end;
3825
3826   FillChar(fDimension, SizeOf(fDimension), 0);
3827   if not Assigned(fData) then begin
3828     fFormat    := tfEmpty;
3829     fPixelSize := 0;
3830     fRowSize   := 0;
3831   end else begin
3832     if aWidth <> -1 then begin
3833       fDimension.Fields := fDimension.Fields + [ffX];
3834       fDimension.X := aWidth;
3835     end;
3836
3837     if aHeight <> -1 then begin
3838       fDimension.Fields := fDimension.Fields + [ffY];
3839       fDimension.Y := aHeight;
3840     end;
3841
3842     s := TFormatDescriptor.Get(aFormat).PixelSize;
3843     fFormat    := aFormat;
3844     fPixelSize := Ceil(s);
3845     fRowSize   := Ceil(s * aWidth);
3846   end;
3847 end;
3848
3849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3850 function TglBitmap.FlipHorz: Boolean;
3851 begin
3852   result := false;
3853 end;
3854
3855 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3856 function TglBitmap.FlipVert: Boolean;
3857 begin
3858   result := false;
3859 end;
3860
3861 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3862 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3863 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3864 procedure TglBitmap.AfterConstruction;
3865 begin
3866   inherited AfterConstruction;
3867
3868   fID         := 0;
3869   fTarget     := 0;
3870   fIsResident := false;
3871
3872   fFormat                  := glBitmapGetDefaultFormat;
3873   fMipMap                  := glBitmapDefaultMipmap;
3874   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
3875   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
3876
3877   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
3878   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
3879 end;
3880
3881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3882 procedure TglBitmap.BeforeDestruction;
3883 begin
3884   SetDataPointer(nil, tfEmpty);
3885   if (fID > 0) and fDeleteTextureOnFree then
3886     glDeleteTextures(1, @fID);
3887   inherited BeforeDestruction;
3888 end;
3889
3890 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3891 procedure TglBitmap.LoadFromFile(const aFilename: String);
3892 var
3893   fs: TFileStream;
3894 begin
3895   fFilename := aFilename;
3896   fs := TFileStream.Create(fFilename, fmOpenRead);
3897   try
3898     fs.Position := 0;
3899     LoadFromStream(fs);
3900   finally
3901     fs.Free;
3902   end;
3903 end;
3904
3905 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3906 procedure TglBitmap.LoadFromStream(const aStream: TStream);
3907 begin
3908   {$IFDEF GLB_SUPPORT_PNG_READ}
3909   if not LoadPNG(aStream) then
3910   {$ENDIF}
3911   {$IFDEF GLB_SUPPORT_JPEG_READ}
3912   if not LoadJPEG(aStream) then
3913   {$ENDIF}
3914   if not LoadDDS(aStream) then
3915   if not LoadTGA(aStream) then
3916   if not LoadBMP(aStream) then
3917     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
3918 end;
3919
3920 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3921 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
3922   const aFormat: TglBitmapFormat; const aArgs: PtrInt);
3923 var
3924   tmpData: PByte;
3925   size: Integer;
3926 begin
3927   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
3928   GetMem(tmpData, size);
3929   try
3930     FillChar(tmpData^, size, #$FF);
3931     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
3932   except
3933     FreeMem(tmpData);
3934     raise;
3935   end;
3936   AddFunc(Self, aFunc, false, Format, aArgs);
3937 end;
3938
3939 {$IFDEF GLB_DELPHI}
3940 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3941 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
3942 var
3943   rs: TResourceStream;
3944   TempPos: Integer;
3945   ResTypeStr: String;
3946   TempResType: PChar;
3947 begin
3948   if not Assigned(ResType) then begin
3949     TempPos     := Pos('.', Resource);
3950     ResTypeStr  := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
3951     Resource    := UpperCase(Copy(Resource, 0, TempPos -1));
3952     TempResType := PChar(ResTypeStr);
3953   end else
3954     TempResType := ResType
3955
3956   rs := TResourceStream.Create(Instance, Resource, TempResType);
3957   try
3958     LoadFromStream(rs);
3959   finally
3960     rs.Free;
3961   end;
3962 end;
3963
3964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3965 procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
3966 var
3967   rs: TResourceStream;
3968 begin
3969   rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
3970   try
3971     LoadFromStream(rs);
3972   finally
3973     rs.Free;
3974   end;
3975 end;
3976 {$ENDIF}
3977
3978 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3979 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
3980 var
3981   fs: TFileStream;
3982 begin
3983   fs := TFileStream.Create(aFileName, fmCreate);
3984   try
3985     fs.Position := 0;
3986     SaveToStream(fs, aFileType);
3987   finally
3988     fs.Free;
3989   end;
3990 end;
3991
3992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3993 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
3994 begin
3995   case aFileType of
3996     {$IFDEF GLB_SUPPORT_PNG_WRITE}
3997     ftPNG:  SavePng(aStream);
3998     {$ENDIF}
3999     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4000     ftJPEG: SaveJPEG(aStream);
4001     {$ENDIF}
4002     ftDDS:  SaveDDS(aStream);
4003     ftTGA:  SaveTGA(aStream);
4004     ftBMP:  SaveBMP(aStream);
4005   end;
4006 end;
4007
4008 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4009 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt): Boolean;
4010 begin
4011   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4012 end;
4013
4014 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4015 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4016   const aFormat: TglBitmapFormat; const aArgs: PtrInt): Boolean;
4017 var
4018   DestData, TmpData, SourceData: pByte;
4019   TempHeight, TempWidth: Integer;
4020   SourceFD, DestFD: TFormatDescriptor;
4021   SourceMD, DestMD: Pointer;
4022
4023   FuncRec: TglBitmapFunctionRec;
4024 begin
4025   Assert(Assigned(Data));
4026   Assert(Assigned(aSource));
4027   Assert(Assigned(aSource.Data));
4028
4029   result := false;
4030   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4031     SourceFD := TFormatDescriptor.Get(aSource.Format);
4032     DestFD   := TFormatDescriptor.Get(aFormat);
4033
4034     // inkompatible Formats so CreateTemp
4035     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4036       aCreateTemp := true;
4037
4038     // Values
4039     TempHeight := Max(1, aSource.Height);
4040     TempWidth  := Max(1, aSource.Width);
4041
4042     FuncRec.Sender := Self;
4043     FuncRec.Args   := aArgs;
4044
4045     TmpData := nil;
4046     if aCreateTemp then begin
4047       GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
4048       DestData := TmpData;
4049     end else
4050       DestData := Data;
4051
4052     try
4053       SourceFD.PreparePixel(FuncRec.Source);
4054       DestFD.PreparePixel  (FuncRec.Dest);
4055
4056       SourceMD := SourceFD.CreateMappingData;
4057       DestMD   := DestFD.CreateMappingData;
4058
4059       FuncRec.Size            := aSource.Dimension;
4060       FuncRec.Position.Fields := FuncRec.Size.Fields;
4061
4062       try
4063         SourceData := aSource.Data;
4064         FuncRec.Position.Y := 0;
4065         while FuncRec.Position.Y < TempHeight do begin
4066           FuncRec.Position.X := 0;
4067           while FuncRec.Position.X < TempWidth do begin
4068             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4069             aFunc(FuncRec);
4070             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4071             inc(FuncRec.Position.X);
4072           end;
4073           inc(FuncRec.Position.Y);
4074         end;
4075
4076         // Updating Image or InternalFormat
4077         if aCreateTemp then
4078           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
4079         else if (aFormat <> fFormat) then
4080           Format := aFormat;
4081
4082         result := true;
4083       finally
4084         SourceFD.FreeMappingData(SourceMD);
4085         DestFD.FreeMappingData(DestMD);
4086       end;
4087     except
4088       if aCreateTemp then
4089         FreeMem(TmpData);
4090       raise;
4091     end;
4092   end;
4093 end;
4094
4095 {$IFDEF GLB_SDL}
4096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4097 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4098 var
4099   Row, RowSize: Integer;
4100   SourceData, TmpData: PByte;
4101   TempDepth: Integer;
4102   Pix: TglBitmapPixelData;
4103   FormatDesc: TglBitmapFormatDescriptor;
4104
4105   function GetRowPointer(Row: Integer): pByte;
4106   begin
4107     result := Surface.pixels;
4108     Inc(result, Row * RowSize);
4109   end;
4110
4111 begin
4112   result := false;
4113
4114   (* TODO
4115   if not FormatIsUncompressed(InternalFormat) then
4116     raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
4117   *)
4118
4119   FormatDesc := FORMAT_DESCRIPTORS[Format];
4120   if Assigned(Data) then begin
4121     case Trunc(FormatDesc.GetSize) of
4122       1: TempDepth :=  8;
4123       2: TempDepth := 16;
4124       3: TempDepth := 24;
4125       4: TempDepth := 32;
4126     else
4127       raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
4128     end;
4129     FormatDesc.PreparePixel(Pix);
4130     with Pix.PixelDesc do
4131       Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4132         RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);
4133
4134     SourceData := Data;
4135     RowSize    := Ceil(FileWidth * FormatDesc.GetSize);
4136
4137     for Row := 0 to FileHeight -1 do begin
4138       TmpData := GetRowPointer(Row);
4139       if Assigned(TmpData) then begin
4140         Move(SourceData^, TmpData^, RowSize);
4141         inc(SourceData, RowSize);
4142       end;
4143     end;
4144     result := true;
4145   end;
4146 end;
4147
4148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4149 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4150 var
4151   pSource, pData, pTempData: PByte;
4152   Row, RowSize, TempWidth, TempHeight: Integer;
4153   IntFormat, f: TglBitmapInternalFormat;
4154   FormatDesc: TglBitmapFormatDescriptor;
4155
4156   function GetRowPointer(Row: Integer): pByte;
4157   begin
4158     result := Surface^.pixels;
4159     Inc(result, Row * RowSize);
4160   end;
4161
4162 begin
4163   result := false;
4164   if (Assigned(Surface)) then begin
4165     with Surface^.format^ do begin
4166       IntFormat := tfEmpty;
4167       for f := Low(f) to High(f) do begin
4168         if FORMAT_DESCRIPTORS[f].MaskMatch(RMask, GMask, BMask, AMask) then begin
4169           IntFormat := f;
4170           break;
4171         end;
4172       end;
4173       if (IntFormat = tfEmpty) then
4174         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4175     end;
4176
4177     FormatDesc := FORMAT_DESCRIPTORS[IntFormat];
4178     TempWidth  := Surface^.w;
4179     TempHeight := Surface^.h;
4180     RowSize := Trunc(TempWidth * FormatDesc.GetSize);
4181     GetMem(pData, TempHeight * RowSize);
4182     try
4183       pTempData := pData;
4184       for Row := 0 to TempHeight -1 do begin
4185         pSource := GetRowPointer(Row);
4186         if (Assigned(pSource)) then begin
4187           Move(pSource^, pTempData^, RowSize);
4188           Inc(pTempData, RowSize);
4189         end;
4190       end;
4191       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4192       result := true;
4193     except
4194       FreeMem(pData);
4195       raise;
4196     end;
4197   end;
4198 end;
4199
4200 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4201 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4202 var
4203   Row, Col, AlphaInterleave: Integer;
4204   pSource, pDest: PByte;
4205
4206   function GetRowPointer(Row: Integer): pByte;
4207   begin
4208     result := aSurface.pixels;
4209     Inc(result, Row * Width);
4210   end;
4211
4212 begin
4213   result := false;
4214   if Assigned(Data) then begin
4215     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4216       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4217
4218       AlphaInterleave := 0;
4219       case Format of
4220         ifLuminance8Alpha8:
4221           AlphaInterleave := 1;
4222         ifBGRA8, ifRGBA8:
4223           AlphaInterleave := 3;
4224       end;
4225
4226       pSource := Data;
4227       for Row := 0 to Height -1 do begin
4228         pDest := GetRowPointer(Row);
4229         if Assigned(pDest) then begin
4230           for Col := 0 to Width -1 do begin
4231             Inc(pSource, AlphaInterleave);
4232             pDest^ := pSource^;
4233             Inc(pDest);
4234             Inc(pSource);
4235           end;
4236         end;
4237       end;
4238       result := true;
4239     end;
4240   end;
4241 end;
4242
4243 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4244 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4245 var
4246   bmp: TglBitmap2D;
4247 begin
4248   bmp := TglBitmap2D.Create;
4249   try
4250     bmp.AssignFromSurface(Surface);
4251     result := AddAlphaFromGlBitmap(bmp, Func, CustomData);
4252   finally
4253     bmp.Free;
4254   end;
4255 end;
4256 {$ENDIF}
4257
4258 {$IFDEF GLB_DELPHI}
4259 //TODO rework & test
4260 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4261 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4262 var
4263   Row: Integer;
4264   pSource, pData: PByte;
4265 begin
4266   result := false;
4267   if Assigned(Data) then begin
4268     if Assigned(aBitmap) then begin
4269       aBitmap.Width  := Width;
4270       aBitmap.Height := Height;
4271
4272       case Format of
4273         tfAlpha8, ifLuminance, ifDepth8:
4274           begin
4275             Bitmap.PixelFormat := pf8bit;
4276             Bitmap.Palette := CreateGrayPalette;
4277           end;
4278         ifRGB5A1:
4279           Bitmap.PixelFormat := pf15bit;
4280         ifR5G6B5:
4281           Bitmap.PixelFormat := pf16bit;
4282         ifRGB8, ifBGR8:
4283           Bitmap.PixelFormat := pf24bit;
4284         ifRGBA8, ifBGRA8:
4285           Bitmap.PixelFormat := pf32bit;
4286         else
4287           raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4288       end;
4289
4290       pSource := Data;
4291       for Row := 0 to FileHeight -1 do begin
4292         pData := Bitmap.Scanline[Row];
4293
4294         Move(pSource^, pData^, fRowSize);
4295         Inc(pSource, fRowSize);
4296
4297         // swap RGB(A) to BGR(A)
4298         if InternalFormat in [ifRGB8, ifRGBA8] then
4299           SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
4300       end;
4301
4302       result := true;
4303     end;
4304   end;
4305 end;
4306
4307 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4308 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4309 var
4310   pSource, pData, pTempData: PByte;
4311   Row, RowSize, TempWidth, TempHeight: Integer;
4312   IntFormat: TglBitmapInternalFormat;
4313 begin
4314   result := false;
4315
4316   if (Assigned(Bitmap)) then begin
4317     case Bitmap.PixelFormat of
4318       pf8bit:
4319         IntFormat := ifLuminance;
4320       pf15bit:
4321         IntFormat := ifRGB5A1;
4322       pf16bit:
4323         IntFormat := ifR5G6B5;
4324       pf24bit:
4325         IntFormat := ifBGR8;
4326       pf32bit:
4327         IntFormat := ifBGRA8;
4328       else
4329         raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4330     end;
4331
4332     TempWidth := Bitmap.Width;
4333     TempHeight := Bitmap.Height;
4334
4335     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
4336
4337     GetMem(pData, TempHeight * RowSize);
4338     try
4339       pTempData := pData;
4340
4341       for Row := 0 to TempHeight -1 do begin
4342         pSource := Bitmap.Scanline[Row];
4343
4344         if (Assigned(pSource)) then begin
4345           Move(pSource^, pTempData^, RowSize);
4346           Inc(pTempData, RowSize);
4347         end;
4348       end;
4349
4350       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4351
4352       result := true;
4353     except
4354       FreeMem(pData);
4355       raise;
4356     end;
4357   end;
4358 end;
4359
4360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4361 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4362 var
4363   Row, Col, AlphaInterleave: Integer;
4364   pSource, pDest: PByte;
4365 begin
4366   result := false;
4367
4368   if Assigned(Data) then begin
4369     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
4370       if Assigned(Bitmap) then begin
4371         Bitmap.PixelFormat := pf8bit;
4372         Bitmap.Palette := CreateGrayPalette;
4373         Bitmap.Width := Width;
4374         Bitmap.Height := Height;
4375
4376         case InternalFormat of
4377           ifLuminanceAlpha:
4378             AlphaInterleave := 1;
4379           ifRGBA8, ifBGRA8:
4380             AlphaInterleave := 3;
4381           else
4382             AlphaInterleave := 0;
4383         end;
4384
4385         // Copy Data
4386         pSource := Data;
4387
4388         for Row := 0 to Height -1 do begin
4389           pDest := Bitmap.Scanline[Row];
4390
4391           if Assigned(pDest) then begin
4392             for Col := 0 to Width -1 do begin
4393               Inc(pSource, AlphaInterleave);
4394               pDest^ := pSource^;
4395               Inc(pDest);
4396               Inc(pSource);
4397             end;
4398           end;
4399         end;
4400
4401         result := true;
4402       end;
4403     end;
4404   end;
4405 end;
4406
4407 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4408 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4409 var
4410   tex: TglBitmap2D;
4411 begin
4412   tex := TglBitmap2D.Create;
4413   try
4414     tex.AssignFromBitmap(Bitmap);
4415     result := AddAlphaFromglBitmap(tex, Func, CustomData);
4416   finally
4417     tex.Free;
4418   end;
4419 end;
4420
4421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4422 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
4423   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4424 var
4425   RS: TResourceStream;
4426   TempPos: Integer;
4427   ResTypeStr: String;
4428   TempResType: PChar;
4429 begin
4430   if Assigned(ResType) then
4431     TempResType := ResType
4432   else
4433     begin
4434       TempPos := Pos('.', Resource);
4435       ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4436       Resource   := UpperCase(Copy(Resource, 0, TempPos -1));
4437       TempResType := PChar(ResTypeStr);
4438     end;
4439
4440   RS := TResourceStream.Create(Instance, Resource, TempResType);
4441   try
4442     result := AddAlphaFromStream(RS, Func, CustomData);
4443   finally
4444     RS.Free;
4445   end;
4446 end;
4447
4448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4449 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
4450   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4451 var
4452   RS: TResourceStream;
4453 begin
4454   RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4455   try
4456     result := AddAlphaFromStream(RS, Func, CustomData);
4457   finally
4458     RS.Free;
4459   end;
4460 end;
4461 {$ENDIF}
4462
4463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4464 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4465 begin
4466   (* TODO
4467   if not FormatIsUncompressed(InternalFormat) then
4468     raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT);
4469   *)
4470   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
4471 end;
4472
4473 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4474 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4475 var
4476   FS: TFileStream;
4477 begin
4478   FS := TFileStream.Create(FileName, fmOpenRead);
4479   try
4480     result := AddAlphaFromStream(FS, aFunc, aArgs);
4481   finally
4482     FS.Free;
4483   end;
4484 end;
4485
4486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4487 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4488 var
4489   tex: TglBitmap2D;
4490 begin
4491   tex := TglBitmap2D.Create(aStream);
4492   try
4493     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4494   finally
4495     tex.Free;
4496   end;
4497 end;
4498
4499 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4500 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4501 var
4502   DestData, DestData2, SourceData: pByte;
4503   TempHeight, TempWidth: Integer;
4504   SourceFD, DestFD: TFormatDescriptor;
4505   SourceMD, DestMD, DestMD2: Pointer;
4506
4507   FuncRec: TglBitmapFunctionRec;
4508 begin
4509   result := false;
4510
4511   Assert(Assigned(Data));
4512   Assert(Assigned(aBitmap));
4513   Assert(Assigned(aBitmap.Data));
4514
4515   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
4516     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
4517     if not Assigned(aFunc) then
4518       aFunc := glBitmapAlphaFunc;
4519
4520     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
4521     DestFD   := TFormatDescriptor.Get(Format);
4522
4523     // Values
4524     TempHeight := aBitmap.FileHeight;
4525     TempWidth  := aBitmap.FileWidth;
4526
4527     FuncRec.Sender          := Self;
4528     FuncRec.Args            := aArgs;
4529     FuncRec.Size            := Dimension;
4530     FuncRec.Position.Fields := FuncRec.Size.Fields;
4531     FuncRec.Args            := PtrInt(SourceFD.HasAlpha) and 1;
4532
4533     DestData   := Data;
4534     DestData2  := Data;
4535     SourceData := aBitmap.Data;
4536
4537     // Mapping
4538     SourceFD.PreparePixel(FuncRec.Source);
4539     DestFD.PreparePixel  (FuncRec.Dest);
4540
4541     SourceMD := SourceFD.CreateMappingData;
4542     DestMD   := DestFD.CreateMappingData;
4543     DestMD2  := DestFD.CreateMappingData;
4544     try
4545       FuncRec.Position.Y := 0;
4546       while FuncRec.Position.Y < TempHeight do begin
4547         FuncRec.Position.X := 0;
4548         while FuncRec.Position.X < TempWidth do begin
4549           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4550           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
4551           aFunc(FuncRec);
4552           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
4553           inc(FuncRec.Position.X);
4554         end;
4555         inc(FuncRec.Position.Y);
4556       end;
4557     finally
4558       SourceFD.FreeMappingData(SourceMD);
4559       DestFD.FreeMappingData(DestMD);
4560       DestFD.FreeMappingData(DestMD2);
4561     end;
4562   end;
4563 end;
4564
4565 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4566 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
4567 begin
4568   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
4569 end;
4570
4571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4572 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
4573 var
4574   PixelData: TglBitmapPixelData;
4575 begin
4576   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
4577   result := AddAlphaFromColorKeyFloat(
4578     aRed   / PixelData.Range.r,
4579     aGreen / PixelData.Range.g,
4580     aBlue  / PixelData.Range.b,
4581     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
4582 end;
4583
4584 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4585 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
4586 var
4587   values: array[0..2] of Single;
4588   tmp: Cardinal;
4589   i: Integer;
4590   PixelData: TglBitmapPixelData;
4591 begin
4592   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
4593   with PixelData do begin
4594     values[0] := aRed;
4595     values[1] := aGreen;
4596     values[2] := aBlue;
4597
4598     for i := 0 to 2 do begin
4599       tmp          := Trunc(Range.arr[i] * aDeviation);
4600       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
4601       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
4602     end;
4603     Data.a  := 0;
4604     Range.a := 0;
4605   end;
4606   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, PtrInt(@PixelData));
4607 end;
4608
4609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4610 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
4611 begin
4612   result := AddAlphaFromValueFloat(aAlpha / $FF);
4613 end;
4614
4615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4616 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
4617 var
4618   PixelData: TglBitmapPixelData;
4619 begin
4620   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
4621   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
4622 end;
4623
4624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4625 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
4626 var
4627   PixelData: TglBitmapPixelData;
4628 begin
4629   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
4630   with PixelData do
4631     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
4632   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, PtrInt(@PixelData.Data.a));
4633 end;
4634
4635 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4636 function TglBitmap.RemoveAlpha: Boolean;
4637 var
4638   FormatDesc: TFormatDescriptor;
4639 begin
4640   result := false;
4641   FormatDesc := TFormatDescriptor.Get(Format);
4642   if Assigned(Data) then begin
4643     if not ({FormatDesc.IsUncompressed or }FormatDesc.HasAlpha) then
4644       raise EglBitmapUnsupportedFormatFormat.Create('RemoveAlpha - ' + UNSUPPORTED_FORMAT);
4645     result := ConvertTo(FormatDesc.WithoutAlpha);
4646   end;
4647 end;
4648
4649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4650 function TglBitmap.Clone: TglBitmap;
4651 var
4652   Temp: TglBitmap;
4653   TempPtr: PByte;
4654   Size: Integer;
4655 begin
4656   result := nil;
4657   Temp := (ClassType.Create as TglBitmap);
4658   try
4659     // copy texture data if assigned
4660     if Assigned(Data) then begin
4661       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
4662       GetMem(TempPtr, Size);
4663       try
4664         Move(Data^, TempPtr^, Size);
4665         Temp.SetDataPointer(TempPtr, Format, Width, Height);
4666       except
4667         FreeMem(TempPtr);
4668         raise;
4669       end;
4670     end else
4671       Temp.SetDataPointer(nil, Format, Width, Height);
4672
4673         // copy properties
4674     Temp.fID                      := ID;
4675     Temp.fTarget                  := Target;
4676     Temp.fFormat                  := Format;
4677     Temp.fMipMap                  := MipMap;
4678     Temp.fAnisotropic             := Anisotropic;
4679     Temp.fBorderColor             := fBorderColor;
4680     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
4681     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
4682     Temp.fFilterMin               := fFilterMin;
4683     Temp.fFilterMag               := fFilterMag;
4684     Temp.fWrapS                   := fWrapS;
4685     Temp.fWrapT                   := fWrapT;
4686     Temp.fWrapR                   := fWrapR;
4687     Temp.fFilename                := fFilename;
4688     Temp.fCustomName              := fCustomName;
4689     Temp.fCustomNameW             := fCustomNameW;
4690     Temp.fCustomData              := fCustomData;
4691
4692     result := Temp;
4693   except
4694     FreeAndNil(Temp);
4695     raise;
4696   end;
4697 end;
4698
4699 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4700 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
4701 var
4702   SourceFD, DestFD: TFormatDescriptor;
4703   SourcePD, DestPD: TglBitmapPixelData;
4704   ShiftData: TShiftData;
4705
4706   function CanCopyDirect: Boolean;
4707   begin
4708     result :=
4709       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
4710       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
4711       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
4712       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
4713   end;
4714
4715   function CanShift: Boolean;
4716   begin
4717     result :=
4718       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
4719       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
4720       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
4721       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
4722   end;
4723
4724   function GetShift(aSource, aDest: Cardinal) : ShortInt;
4725   begin
4726     result := 0;
4727     while (aSource > aDest) and (aSource > 0) do begin
4728       inc(result);
4729       aSource := aSource shr 1;
4730     end;
4731   end;
4732
4733 begin
4734   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
4735     SourceFD := TFormatDescriptor.Get(Format);
4736     DestFD   := TFormatDescriptor.Get(aFormat);
4737
4738     SourceFD.PreparePixel(SourcePD);
4739     DestFD.PreparePixel  (DestPD);
4740
4741     if CanCopyDirect then
4742       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
4743     else if CanShift then begin
4744       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
4745       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
4746       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
4747       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
4748       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, PtrInt(@ShiftData));
4749     end else
4750       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
4751   end else
4752     result := true;
4753 end;
4754
4755 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4756 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
4757 begin
4758   if aUseRGB or aUseAlpha then
4759     AddFunc(glBitmapInvertFunc, false, ((PtrInt(aUseAlpha) and 1) shl 1) or (PtrInt(aUseRGB) and 1));
4760 end;
4761
4762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4763 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
4764 begin
4765   fBorderColor[0] := aRed;
4766   fBorderColor[1] := aGreen;
4767   fBorderColor[2] := aBlue;
4768   fBorderColor[3] := aAlpha;
4769   if (ID > 0) then begin
4770     Bind(false);
4771     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
4772   end;
4773 end;
4774
4775 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4776 procedure TglBitmap.FreeData;
4777 begin
4778   SetDataPointer(nil, tfEmpty);
4779 end;
4780
4781 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4782 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
4783   const aAlpha: Byte);
4784 begin
4785   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
4786 end;
4787
4788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4789 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
4790 var
4791   PixelData: TglBitmapPixelData;
4792 begin
4793   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
4794   FillWithColorFloat(
4795     aRed   / PixelData.Range.r,
4796     aGreen / PixelData.Range.g,
4797     aBlue  / PixelData.Range.b,
4798     aAlpha / PixelData.Range.a);
4799 end;
4800
4801 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4802 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
4803 var
4804   PixelData: TglBitmapPixelData;
4805 begin
4806   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
4807   with PixelData do begin
4808     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
4809     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
4810     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
4811     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
4812   end;
4813   AddFunc(glBitmapFillWithColorFunc, false, PtrInt(@PixelData));
4814 end;
4815
4816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4817 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
4818 begin
4819   //check MIN filter
4820   case aMin of
4821     GL_NEAREST:
4822       fFilterMin := GL_NEAREST;
4823     GL_LINEAR:
4824       fFilterMin := GL_LINEAR;
4825     GL_NEAREST_MIPMAP_NEAREST:
4826       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
4827     GL_LINEAR_MIPMAP_NEAREST:
4828       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
4829     GL_NEAREST_MIPMAP_LINEAR:
4830       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
4831     GL_LINEAR_MIPMAP_LINEAR:
4832       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
4833     else
4834       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
4835   end;
4836
4837   //check MAG filter
4838   case aMag of
4839     GL_NEAREST:
4840       fFilterMag := GL_NEAREST;
4841     GL_LINEAR:
4842       fFilterMag := GL_LINEAR;
4843     else
4844       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
4845   end;
4846
4847   //apply filter
4848   if (ID > 0) then begin
4849     Bind(false);
4850     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
4851
4852     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
4853       case fFilterMin of
4854         GL_NEAREST, GL_LINEAR:
4855           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
4856         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
4857           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
4858         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
4859           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
4860       end;
4861     end else
4862       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
4863   end;
4864 end;
4865
4866 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4867 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
4868
4869   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
4870   begin
4871     case aValue of
4872       GL_CLAMP:
4873         aTarget := GL_CLAMP;
4874
4875       GL_REPEAT:
4876         aTarget := GL_REPEAT;
4877
4878       GL_CLAMP_TO_EDGE: begin
4879         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
4880           aTarget := GL_CLAMP_TO_EDGE
4881         else
4882           aTarget := GL_CLAMP;
4883       end;
4884
4885       GL_CLAMP_TO_BORDER: begin
4886         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
4887           aTarget := GL_CLAMP_TO_BORDER
4888         else
4889           aTarget := GL_CLAMP;
4890       end;
4891
4892       GL_MIRRORED_REPEAT: begin
4893         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
4894           aTarget := GL_MIRRORED_REPEAT
4895         else
4896           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
4897       end;
4898     else
4899       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
4900     end;
4901   end;
4902
4903 begin
4904   CheckAndSetWrap(S, fWrapS);
4905   CheckAndSetWrap(T, fWrapT);
4906   CheckAndSetWrap(R, fWrapR);
4907
4908   if (ID > 0) then begin
4909     Bind(false);
4910     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
4911     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
4912     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
4913   end;
4914 end;
4915
4916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4917 procedure TglBitmap.GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);
4918 begin
4919   { TODO delete?
4920   if Assigned (fGetPixelFunc) then
4921     fGetPixelFunc(aPos, aPixel);
4922     }
4923 end;
4924
4925 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4926 procedure TglBitmap.SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData);
4927 begin
4928   {TODO delete?
4929   if Assigned (fSetPixelFunc) then
4930     fSetPixelFuc(aPos, aPixel);
4931     }
4932 end;
4933
4934 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4935 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
4936 begin
4937   if aEnableTextureUnit then
4938     glEnable(Target);
4939   if (ID > 0) then
4940     glBindTexture(Target, ID);
4941 end;
4942
4943 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4944 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
4945 begin
4946   if aDisableTextureUnit then
4947     glDisable(Target);
4948   glBindTexture(Target, 0);
4949 end;
4950
4951 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4952 constructor TglBitmap.Create;
4953 begin
4954 {$IFNDEF GLB_NO_NATIVE_GL}
4955   ReadOpenGLExtensions;
4956 {$ENDIF}
4957   if (ClassType = TglBitmap) then
4958     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
4959   inherited Create;
4960 end;
4961
4962 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4963 constructor TglBitmap.Create(const aFileName: String);
4964 begin
4965   Create;
4966   LoadFromFile(FileName);
4967 end;
4968
4969 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4970 constructor TglBitmap.Create(const aStream: TStream);
4971 begin
4972   Create;
4973   LoadFromStream(aStream);
4974 end;
4975
4976 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4977 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
4978 var
4979   Image: PByte;
4980   ImageSize: Integer;
4981 begin
4982   Create;
4983   TFormatDescriptor.Get(aFormat).GetSize(aSize);
4984   GetMem(Image, ImageSize);
4985   try
4986     FillChar(Image^, ImageSize, #$FF);
4987     SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
4988   except
4989     FreeMem(Image);
4990     raise;
4991   end;
4992 end;
4993
4994 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4995 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
4996   const aFunc: TglBitmapFunction; const aArgs: PtrInt);
4997 begin
4998   Create;
4999   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5000 end;
5001
5002 {$IFDEF GLB_DELPHI}
5003 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5004 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5005 begin
5006   Create;
5007   LoadFromResource(aInstance, aResource, aResType);
5008 end;
5009
5010 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5011 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5012 begin
5013   Create;
5014   LoadFromResourceID(aInstance, aResourceID, aResType);
5015 end;
5016 {$ENDIF}
5017
5018 {$IFDEF GLB_SUPPORT_PNG_READ}
5019 {$IF DEFINED(GLB_SDL_IMAGE)}
5020 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5021 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5022 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5023 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5024 var
5025   Surface: PSDL_Surface;
5026   RWops: PSDL_RWops;
5027 begin
5028   result := false;
5029   RWops := glBitmapCreateRWops(aStream);
5030   try
5031     if IMG_isPNG(RWops) > 0 then begin
5032       Surface := IMG_LoadPNG_RW(RWops);
5033       try
5034         AssignFromSurface(Surface);
5035         Rresult := true;
5036       finally
5037         SDL_FreeSurface(Surface);
5038       end;
5039     end;
5040   finally
5041     SDL_FreeRW(RWops);
5042   end;
5043 end;
5044
5045 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5046 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5047 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5048 begin
5049   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5050 end;
5051
5052 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5053 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5054 var
5055   StreamPos: Int64;
5056   signature: array [0..7] of byte;
5057   png: png_structp;
5058   png_info: png_infop;
5059
5060   TempHeight, TempWidth: Integer;
5061   Format: TglBitmapInternalFormat;
5062
5063   png_data: pByte;
5064   png_rows: array of pByte;
5065   Row, LineSize: Integer;
5066 begin
5067   result := false;
5068
5069   if not init_libPNG then
5070     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5071
5072   try
5073     // signature
5074     StreamPos := Stream.Position;
5075     Stream.Read(signature, 8);
5076     Stream.Position := StreamPos;
5077
5078     if png_check_sig(@signature, 8) <> 0 then begin
5079       // png read struct
5080       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5081       if png = nil then
5082         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5083
5084       // png info
5085       png_info := png_create_info_struct(png);
5086       if png_info = nil then begin
5087         png_destroy_read_struct(@png, nil, nil);
5088         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5089       end;
5090
5091       // set read callback
5092       png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
5093
5094       // read informations
5095       png_read_info(png, png_info);
5096
5097       // size
5098       TempHeight := png_get_image_height(png, png_info);
5099       TempWidth := png_get_image_width(png, png_info);
5100
5101       // format
5102       case png_get_color_type(png, png_info) of
5103         PNG_COLOR_TYPE_GRAY:
5104           Format := tfLuminance8;
5105         PNG_COLOR_TYPE_GRAY_ALPHA:
5106           Format := tfLuminance8Alpha8;
5107         PNG_COLOR_TYPE_RGB:
5108           Format := tfRGB8;
5109         PNG_COLOR_TYPE_RGB_ALPHA:
5110           Format := tfRGBA8;
5111         else
5112           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5113       end;
5114
5115       // cut upper 8 bit from 16 bit formats
5116       if png_get_bit_depth(png, png_info) > 8 then
5117         png_set_strip_16(png);
5118
5119       // expand bitdepth smaller than 8
5120       if png_get_bit_depth(png, png_info) < 8 then
5121         png_set_expand(png);
5122
5123       // allocating mem for scanlines
5124       LineSize := png_get_rowbytes(png, png_info);
5125       GetMem(png_data, TempHeight * LineSize);
5126       try
5127         SetLength(png_rows, TempHeight);
5128         for Row := Low(png_rows) to High(png_rows) do begin
5129           png_rows[Row] := png_data;
5130           Inc(png_rows[Row], Row * LineSize);
5131         end;
5132
5133         // read complete image into scanlines
5134         png_read_image(png, @png_rows[0]);
5135
5136         // read end
5137         png_read_end(png, png_info);
5138
5139         // destroy read struct
5140         png_destroy_read_struct(@png, @png_info, nil);
5141
5142         SetLength(png_rows, 0);
5143
5144         // set new data
5145         SetDataPointer(png_data, Format, TempWidth, TempHeight);
5146
5147         result := true;
5148       except
5149         FreeMem(png_data);
5150         raise;
5151       end;
5152     end;
5153   finally
5154     quit_libPNG;
5155   end;
5156 end;
5157
5158 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5159 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5160 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5161 var
5162   StreamPos: Int64;
5163   Png: TPNGObject;
5164   Header: Array[0..7] of Byte;
5165   Row, Col, PixSize, LineSize: Integer;
5166   NewImage, pSource, pDest, pAlpha: pByte;
5167   Format: TglBitmapInternalFormat;
5168
5169 const
5170   PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
5171
5172 begin
5173   result := false;
5174
5175   StreamPos := Stream.Position;
5176   Stream.Read(Header[0], SizeOf(Header));
5177   Stream.Position := StreamPos;
5178
5179   {Test if the header matches}
5180   if Header = PngHeader then begin
5181     Png := TPNGObject.Create;
5182     try
5183       Png.LoadFromStream(Stream);
5184
5185       case Png.Header.ColorType of
5186         COLOR_GRAYSCALE:
5187           Format := ifLuminance;
5188         COLOR_GRAYSCALEALPHA:
5189           Format := ifLuminanceAlpha;
5190         COLOR_RGB:
5191           Format := ifBGR8;
5192         COLOR_RGBALPHA:
5193           Format := ifBGRA8;
5194         else
5195           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5196       end;
5197
5198       PixSize := Trunc(FormatGetSize(Format));
5199       LineSize := Integer(Png.Header.Width) * PixSize;
5200
5201       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5202       try
5203         pDest := NewImage;
5204
5205         case Png.Header.ColorType of
5206           COLOR_RGB, COLOR_GRAYSCALE:
5207             begin
5208               for Row := 0 to Png.Height -1 do begin
5209                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5210                 Inc(pDest, LineSize);
5211               end;
5212             end;
5213           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5214             begin
5215               PixSize := PixSize -1;
5216
5217               for Row := 0 to Png.Height -1 do begin
5218                 pSource := Png.Scanline[Row];
5219                 pAlpha := pByte(Png.AlphaScanline[Row]);
5220
5221                 for Col := 0 to Png.Width -1 do begin
5222                   Move (pSource^, pDest^, PixSize);
5223                   Inc(pSource, PixSize);
5224                   Inc(pDest, PixSize);
5225
5226                   pDest^ := pAlpha^;
5227                   inc(pAlpha);
5228                   Inc(pDest);
5229                 end;
5230               end;
5231             end;
5232           else
5233             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5234         end;
5235
5236         SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
5237
5238         result := true;
5239       except
5240         FreeMem(NewImage);
5241         raise;
5242       end;
5243     finally
5244       Png.Free;
5245     end;
5246   end;
5247 end;
5248 {$IFEND}
5249 {$ENDIF}
5250
5251 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5252 {$IFDEF GLB_LIB_PNG}
5253 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5254 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5255 begin
5256   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5257 end;
5258 {$ENDIF}
5259
5260 {$IF DEFINED(GLB_LIB_PNG)}
5261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5262 procedure TglBitmap.SavePNG(const aStream: TStream);
5263 var
5264   png: png_structp;
5265   png_info: png_infop;
5266   png_rows: array of pByte;
5267   LineSize: Integer;
5268   ColorType: Integer;
5269   Row: Integer;
5270 begin
5271   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
5272     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5273
5274   if not init_libPNG then
5275     raise Exception.Create('SavePNG - unable to initialize libPNG.');
5276
5277   try
5278     case FInternalFormat of
5279       ifAlpha, ifLuminance, ifDepth8:
5280         ColorType := PNG_COLOR_TYPE_GRAY;
5281       ifLuminanceAlpha:
5282         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5283       ifBGR8, ifRGB8:
5284         ColorType := PNG_COLOR_TYPE_RGB;
5285       ifBGRA8, ifRGBA8:
5286         ColorType := PNG_COLOR_TYPE_RGBA;
5287       else
5288         raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5289     end;
5290     LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
5291
5292     // creating array for scanline
5293     SetLength(png_rows, Height);
5294     try
5295       for Row := 0 to Height - 1 do begin
5296         png_rows[Row] := Data;
5297         Inc(png_rows[Row], Row * LineSize)
5298       end;
5299
5300       // write struct
5301       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5302       if png = nil then
5303         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5304
5305       // create png info
5306       png_info := png_create_info_struct(png);
5307       if png_info = nil then begin
5308         png_destroy_write_struct(@png, nil);
5309         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5310       end;
5311
5312       // set read callback
5313       png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
5314
5315       // set compression
5316       png_set_compression_level(png, 6);
5317
5318       if InternalFormat in [ifBGR8, ifBGRA8] then
5319         png_set_bgr(png);
5320
5321       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5322       png_write_info(png, png_info);
5323       png_write_image(png, @png_rows[0]);
5324       png_write_end(png, png_info);
5325       png_destroy_write_struct(@png, @png_info);
5326     finally
5327       SetLength(png_rows, 0);
5328     end;
5329   finally
5330     quit_libPNG;
5331   end;
5332 end;
5333
5334 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5336 procedure TglBitmap.SavePNG(const aStream: TStream);
5337 var
5338   Png: TPNGObject;
5339
5340   pSource, pDest: pByte;
5341   X, Y, PixSize: Integer;
5342   ColorType: Cardinal;
5343   Alpha: Boolean;
5344
5345   pTemp: pByte;
5346   Temp: Byte;
5347 begin
5348   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
5349     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5350
5351   case FInternalFormat of
5352     ifAlpha, ifLuminance, ifDepth8: begin
5353       ColorType := COLOR_GRAYSCALE;
5354       PixSize := 1;
5355       Alpha := false;
5356     end;
5357     ifLuminanceAlpha: begin
5358       ColorType := COLOR_GRAYSCALEALPHA;
5359       PixSize := 1;
5360       Alpha := true;
5361     end;
5362     ifBGR8, ifRGB8: begin
5363       ColorType := COLOR_RGB;
5364       PixSize := 3;
5365       Alpha := false;
5366     end;
5367     ifBGRA8, ifRGBA8: begin
5368       ColorType := COLOR_RGBALPHA;
5369       PixSize := 3;
5370       Alpha := true
5371     end;
5372   else
5373     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5374   end;
5375
5376   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5377   try
5378     // Copy ImageData
5379     pSource := Data;
5380     for Y := 0 to Height -1 do begin
5381       pDest := png.ScanLine[Y];
5382       for X := 0 to Width -1 do begin
5383         Move(pSource^, pDest^, PixSize);
5384         Inc(pDest, PixSize);
5385         Inc(pSource, PixSize);
5386         if Alpha then begin
5387           png.AlphaScanline[Y]^[X] := pSource^;
5388           Inc(pSource);
5389         end;
5390       end;
5391
5392       // convert RGB line to BGR
5393       if InternalFormat in [ifRGB8, ifRGBA8] then begin
5394         pTemp := png.ScanLine[Y];
5395         for X := 0 to Width -1 do begin
5396           Temp := pByteArray(pTemp)^[0];
5397           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5398           pByteArray(pTemp)^[2] := Temp;
5399           Inc(pTemp, 3);
5400         end;
5401       end;
5402     end;
5403
5404     // Save to Stream
5405     Png.CompressionLevel := 6;
5406     Png.SaveToStream(Stream);
5407   finally
5408     FreeAndNil(Png);
5409   end;
5410 end;
5411 {$IFEND}
5412 {$ENDIF}
5413
5414 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5415 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5417 {$IFDEF GLB_LIB_JPEG}
5418 type
5419   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
5420   glBitmap_libJPEG_source_mgr = record
5421     pub: jpeg_source_mgr;
5422
5423     SrcStream: TStream;
5424     SrcBuffer: array [1..4096] of byte;
5425   end;
5426
5427   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
5428   glBitmap_libJPEG_dest_mgr = record
5429     pub: jpeg_destination_mgr;
5430
5431     DestStream: TStream;
5432     DestBuffer: array [1..4096] of byte;
5433   end;
5434
5435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5436 {
5437 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
5438 var
5439   Msg: String;
5440 begin
5441   SetLength(Msg, 256);
5442   cinfo^.err^.format_message(cinfo, pChar(Msg));
5443   Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
5444   cinfo^.global_state := 0;
5445   jpeg_abort(cinfo);
5446 end;
5447 }
5448
5449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5450 {
5451 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
5452 var
5453   Msg: String;
5454 begin
5455   SetLength(Msg, 256);
5456   cinfo^.err^.format_message(cinfo, pChar(Msg));
5457   Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
5458   cinfo^.global_state := 0;
5459 end;
5460 }
5461
5462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5463 {
5464 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
5465 begin
5466 end;
5467 }
5468
5469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5470 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
5471 var
5472   src: glBitmap_libJPEG_source_mgr_ptr;
5473   bytes: integer;
5474 begin
5475   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5476
5477   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
5478         if (bytes <= 0) then begin
5479                 src^.SrcBuffer[1] := $FF;
5480                 src^.SrcBuffer[2] := JPEG_EOI;
5481                 bytes := 2;
5482         end;
5483
5484         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
5485         src^.pub.bytes_in_buffer := bytes;
5486
5487   result := true;
5488 end;
5489
5490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5491 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
5492 var
5493   src: glBitmap_libJPEG_source_mgr_ptr;
5494 begin
5495   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5496
5497   if num_bytes > 0 then begin
5498     // wanted byte isn't in buffer so set stream position and read buffer
5499     if num_bytes > src^.pub.bytes_in_buffer then begin
5500       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
5501       src^.pub.fill_input_buffer(cinfo);
5502     end else begin
5503       // wanted byte is in buffer so only skip
5504                 inc(src^.pub.next_input_byte, num_bytes);
5505                 dec(src^.pub.bytes_in_buffer, num_bytes);
5506     end;
5507   end;
5508 end;
5509
5510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5511 {
5512 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
5513 begin
5514 end;
5515 }
5516
5517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5518 {
5519 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
5520 begin
5521 end;
5522 }
5523
5524 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5525 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
5526 var
5527   dest: glBitmap_libJPEG_dest_mgr_ptr;
5528 begin
5529   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5530
5531   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
5532     // write complete buffer
5533     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
5534
5535     // reset buffer
5536     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
5537     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
5538   end;
5539
5540   result := true;
5541 end;
5542
5543 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5544 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
5545 var
5546   Idx: Integer;
5547   dest: glBitmap_libJPEG_dest_mgr_ptr;
5548 begin
5549   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5550
5551   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
5552     // check for endblock
5553     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
5554       // write endblock
5555       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
5556
5557       // leave
5558       break;
5559     end else
5560       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
5561   end;
5562 end;
5563 {$ENDIF}
5564
5565 {$IFDEF GLB_SUPPORT_JPEG_READ}
5566 {$IF DEFINED(GLB_SDL_IMAGE)}
5567 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5568 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
5569 var
5570   Surface: PSDL_Surface;
5571   RWops: PSDL_RWops;
5572 begin
5573   result := false;
5574
5575   RWops := glBitmapCreateRWops(Stream);
5576   try
5577     if IMG_isJPG(RWops) > 0 then begin
5578       Surface := IMG_LoadJPG_RW(RWops);
5579       try
5580         AssignFromSurface(Surface);
5581         result := true;
5582       finally
5583         SDL_FreeSurface(Surface);
5584       end;
5585     end;
5586   finally
5587     SDL_FreeRW(RWops);
5588   end;
5589 end;
5590
5591 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
5592 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5593 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
5594 var
5595   StreamPos: Int64;
5596   Temp: array[0..1]of Byte;
5597
5598   jpeg: jpeg_decompress_struct;
5599   jpeg_err: jpeg_error_mgr;
5600
5601   IntFormat: TglBitmapInternalFormat;
5602   pImage: pByte;
5603   TempHeight, TempWidth: Integer;
5604
5605   pTemp: pByte;
5606   Row: Integer;
5607 begin
5608   result := false;
5609
5610   if not init_libJPEG then
5611     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
5612
5613   try
5614     // reading first two bytes to test file and set cursor back to begin
5615     StreamPos := Stream.Position;
5616     Stream.Read(Temp[0], 2);
5617     Stream.Position := StreamPos;
5618
5619     // if Bitmap then read file.
5620     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5621       FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
5622       FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
5623
5624       // error managment
5625       jpeg.err := jpeg_std_error(@jpeg_err);
5626       jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
5627       jpeg_err.output_message := glBitmap_libJPEG_output_message;
5628
5629       // decompression struct
5630       jpeg_create_decompress(@jpeg);
5631
5632       // allocation space for streaming methods
5633       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
5634
5635       // seeting up custom functions
5636       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
5637         pub.init_source       := glBitmap_libJPEG_init_source;
5638         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
5639         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
5640         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
5641         pub.term_source       := glBitmap_libJPEG_term_source;
5642
5643         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
5644         pub.next_input_byte := nil;   // until buffer loaded
5645
5646         SrcStream := Stream;
5647       end;
5648
5649       // set global decoding state
5650       jpeg.global_state := DSTATE_START;
5651
5652       // read header of jpeg
5653       jpeg_read_header(@jpeg, false);
5654
5655       // setting output parameter
5656       case jpeg.jpeg_color_space of
5657         JCS_GRAYSCALE:
5658           begin
5659             jpeg.out_color_space := JCS_GRAYSCALE;
5660             IntFormat := ifLuminance;
5661           end;
5662         else
5663           jpeg.out_color_space := JCS_RGB;
5664           IntFormat := ifRGB8;
5665       end;
5666
5667       // reading image
5668       jpeg_start_decompress(@jpeg);
5669
5670       TempHeight := jpeg.output_height;
5671       TempWidth := jpeg.output_width;
5672
5673       // creating new image
5674       GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
5675       try
5676         pTemp := pImage;
5677
5678         for Row := 0 to TempHeight -1 do begin
5679           jpeg_read_scanlines(@jpeg, @pTemp, 1);
5680           Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
5681         end;
5682
5683         // finish decompression
5684         jpeg_finish_decompress(@jpeg);
5685
5686         // destroy decompression
5687         jpeg_destroy_decompress(@jpeg);
5688
5689         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
5690
5691         result := true;
5692       except
5693         FreeMem(pImage);
5694         raise;
5695       end;
5696     end;
5697   finally
5698     quit_libJPEG;
5699   end;
5700 end;
5701
5702 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5703 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5704 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
5705 var
5706   bmp: TBitmap;
5707   jpg: TJPEGImage;
5708   StreamPos: Int64;
5709   Temp: array[0..1]of Byte;
5710 begin
5711   result := false;
5712
5713   // reading first two bytes to test file and set cursor back to begin
5714   StreamPos := Stream.Position;
5715   Stream.Read(Temp[0], 2);
5716   Stream.Position := StreamPos;
5717
5718   // if Bitmap then read file.
5719   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5720     bmp := TBitmap.Create;
5721     try
5722       jpg := TJPEGImage.Create;
5723       try
5724         jpg.LoadFromStream(Stream);
5725         bmp.Assign(jpg);
5726         result := AssignFromBitmap(bmp);
5727       finally
5728         jpg.Free;
5729       end;
5730     finally
5731       bmp.Free;
5732     end;
5733   end;
5734 end;
5735 {$IFEND}
5736 {$ENDIF}
5737
5738 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5739 {$IF DEFEFINED(GLB_LIB_JPEG)}
5740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5741 procedure TglBitmap.SaveJPEG(Stream: TStream);
5742 var
5743   jpeg: jpeg_compress_struct;
5744   jpeg_err: jpeg_error_mgr;
5745   Row: Integer;
5746   pTemp, pTemp2: pByte;
5747
5748   procedure CopyRow(pDest, pSource: pByte);
5749   var
5750     X: Integer;
5751   begin
5752     for X := 0 to Width - 1 do begin
5753       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
5754       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
5755       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
5756       Inc(pDest, 3);
5757       Inc(pSource, 3);
5758     end;
5759   end;
5760
5761 begin
5762   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
5763     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
5764
5765   if not init_libJPEG then
5766     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
5767
5768   try
5769     FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
5770     FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
5771
5772     // error managment
5773     jpeg.err := jpeg_std_error(@jpeg_err);
5774     jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
5775     jpeg_err.output_message := glBitmap_libJPEG_output_message;
5776
5777     // compression struct
5778     jpeg_create_compress(@jpeg);
5779
5780     // allocation space for streaming methods
5781     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
5782
5783     // seeting up custom functions
5784     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
5785       pub.init_destination    := glBitmap_libJPEG_init_destination;
5786       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
5787       pub.term_destination    := glBitmap_libJPEG_term_destination;
5788
5789       pub.next_output_byte  := @DestBuffer[1];
5790       pub.free_in_buffer    := Length(DestBuffer);
5791
5792       DestStream := Stream;
5793     end;
5794
5795     // very important state
5796     jpeg.global_state := CSTATE_START;
5797     jpeg.image_width  := Width;
5798     jpeg.image_height := Height;
5799     case InternalFormat of
5800       ifAlpha, ifLuminance, ifDepth8: begin
5801         jpeg.input_components := 1;
5802         jpeg.in_color_space := JCS_GRAYSCALE;
5803       end;
5804       ifRGB8, ifBGR8: begin
5805         jpeg.input_components := 3;
5806         jpeg.in_color_space := JCS_RGB;
5807       end;
5808     end;
5809
5810     jpeg_set_defaults(@jpeg);
5811     jpeg_set_quality(@jpeg, 95, true);
5812     jpeg_start_compress(@jpeg, true);
5813     pTemp := Data;
5814
5815     if InternalFormat = ifBGR8 then
5816       GetMem(pTemp2, fRowSize)
5817     else
5818       pTemp2 := pTemp;
5819
5820     try
5821       for Row := 0 to jpeg.image_height -1 do begin
5822         // prepare row
5823         if InternalFormat = ifBGR8 then
5824           CopyRow(pTemp2, pTemp)
5825         else
5826           pTemp2 := pTemp;
5827
5828         // write row
5829         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
5830         inc(pTemp, fRowSize);
5831       end;
5832     finally
5833       // free memory
5834       if InternalFormat = ifBGR8 then
5835         FreeMem(pTemp2);
5836     end;
5837     jpeg_finish_compress(@jpeg);
5838     jpeg_destroy_compress(@jpeg);
5839   finally
5840     quit_libJPEG;
5841   end;
5842 end;
5843
5844 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5845 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5846 procedure TglBitmap.SaveJPEG(Stream: TStream);
5847 var
5848   Bmp: TBitmap;
5849   Jpg: TJPEGImage;
5850 begin
5851   if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
5852     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
5853
5854   Bmp := TBitmap.Create;
5855   try
5856     Jpg := TJPEGImage.Create;
5857     try
5858       AssignToBitmap(Bmp);
5859       if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
5860         Jpg.Grayscale := true;
5861         Jpg.PixelFormat := jf8Bit;
5862       end;
5863       Jpg.Assign(Bmp);
5864       Jpg.SaveToStream(Stream);
5865     finally
5866       FreeAndNil(Jpg);
5867     end;
5868   finally
5869     FreeAndNil(Bmp);
5870   end;
5871 end;
5872 {$ENDIF}
5873 {$ENDIF}
5874
5875 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5876 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5877 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5878 const
5879   BMP_MAGIC          = $4D42;
5880
5881   BMP_COMP_RGB       = 0;
5882   BMP_COMP_RLE8      = 1;
5883   BMP_COMP_RLE4      = 2;
5884   BMP_COMP_BITFIELDS = 3;
5885
5886 type
5887   TBMPHeader = packed record
5888     bfType: Word;
5889     bfSize: Cardinal;
5890     bfReserved1: Word;
5891     bfReserved2: Word;
5892     bfOffBits: Cardinal;
5893   end;
5894
5895   TBMPInfo = packed record
5896     biSize: Cardinal;
5897     biWidth: Longint;
5898     biHeight: Longint;
5899     biPlanes: Word;
5900     biBitCount: Word;
5901     biCompression: Cardinal;
5902     biSizeImage: Cardinal;
5903     biXPelsPerMeter: Longint;
5904     biYPelsPerMeter: Longint;
5905     biClrUsed: Cardinal;
5906     biClrImportant: Cardinal;
5907   end;
5908
5909   (* TODO: delete?
5910   TBMPInfoOS = packed record
5911     biSize: Cardinal;
5912     biWidth: Longint;
5913     biHeight: Longint;
5914     biPlanes: Word;
5915     biBitCount: Word;
5916   end;
5917   *)
5918
5919 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5920 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
5921
5922   //////////////////////////////////////////////////////////////////////////////////////////////////
5923   function ReadInfo(var aInfo: TBMPInfo; var aMask: TglBitmapColorRec): TglBitmapFormat;
5924   begin
5925     result := tfEmpty;
5926     aStream.Read(aInfo, SizeOf(aInfo));
5927     FillChar(aMask, SizeOf(aMask), 0);
5928
5929     //Read Compression
5930     case aInfo.biCompression of
5931       BMP_COMP_RLE4,
5932       BMP_COMP_RLE8: begin
5933         raise EglBitmapException.Create('RLE compression is not supported');
5934       end;
5935       BMP_COMP_BITFIELDS: begin
5936         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
5937           aStream.Read(aMask.r, SizeOf(aMask.r));
5938           aStream.Read(aMask.g, SizeOf(aMask.g));
5939           aStream.Read(aMask.b, SizeOf(aMask.b));
5940           aStream.Read(aMask.a, SizeOf(aMask.a));
5941         end else
5942           raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
5943       end;
5944     end;
5945
5946     //get suitable format
5947     case aInfo.biBitCount of
5948        8: result := tfLuminance8;
5949       16: result := tfBGR5;
5950       24: result := tfBGR8;
5951       32: result := tfBGRA8;
5952     end;
5953   end;
5954
5955   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TColorTableFormat;
5956   var
5957     i, c: Integer;
5958     ColorTable: TColorTable;
5959   begin
5960     result := nil;
5961     if (aInfo.biBitCount >= 16) then
5962       exit;
5963     aFormat := tfLuminance8;
5964     c := aInfo.biClrUsed;
5965     if (c = 0) then
5966       c := 1 shl aInfo.biBitCount;
5967     SetLength(ColorTable, c);
5968     for i := 0 to c-1 do begin
5969       aStream.Read(ColorTable[i], SizeOf(TColorTableEnty));
5970       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
5971         aFormat := tfRGB8;
5972     end;
5973
5974     result := TColorTableFormat.Create;
5975     result.PixelSize  := aInfo.biBitCount / 8;
5976     result.ColorTable := ColorTable;
5977     result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
5978   end;
5979
5980   //////////////////////////////////////////////////////////////////////////////////////////////////
5981   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
5982     const aInfo: TBMPInfo): TBitfieldFormat;
5983   var
5984     TmpFormat: TglBitmapFormat;
5985     FormatDesc: TFormatDescriptor;
5986   begin
5987     result := nil;
5988     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
5989       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
5990         FormatDesc := TFormatDescriptor.Get(TmpFormat);
5991         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
5992           aFormat := FormatDesc.Format;
5993           exit;
5994         end;
5995       end;
5996
5997       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
5998         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
5999       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6000         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6001
6002       result := TBitfieldFormat.Create;
6003       result.PixelSize := aInfo.biBitCount / 8;
6004       result.RedMask   := aMask.r;
6005       result.GreenMask := aMask.g;
6006       result.BlueMask  := aMask.b;
6007       result.AlphaMask := aMask.a;
6008     end;
6009   end;
6010
6011 var
6012   //simple types
6013   StartPos: Int64;
6014   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6015   PaddingBuff: Cardinal;
6016   LineBuf, ImageData, TmpData: PByte;
6017   SourceMD, DestMD: Pointer;
6018   BmpFormat: TglBitmapFormat;
6019   ColorTable: TColorTable;
6020
6021   //records
6022   Mask: TglBitmapColorRec;
6023   Header: TBMPHeader;
6024   Info: TBMPInfo;
6025
6026   //classes
6027   SpecialFormat: TFormatDescriptor;
6028   FormatDesc: TFormatDescriptor;
6029
6030   //////////////////////////////////////////////////////////////////////////////////////////////////
6031   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6032   var
6033     i, j: Integer;
6034     Pixel: TglBitmapPixelData;
6035   begin
6036     aStream.Read(aLineBuf^, rbLineSize);
6037     SpecialFormat.PreparePixel(Pixel);
6038     for i := 0 to Info.biWidth-1 do begin
6039       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6040       with FormatDesc do begin
6041         //TODO: use convert function
6042         for j := 0 to 3 do
6043           if (SpecialFormat.Range.arr[j] <> Range.arr[j]) then begin
6044             if (SpecialFormat.Range.arr[j] > 0) then
6045               Pixel.Data.arr[j] := Round(Pixel.Data.arr[j] / SpecialFormat.Range.arr[j] * Range.arr[j])
6046             else
6047               Pixel.Data.arr[j] := 0;
6048           end;
6049       end;
6050       FormatDesc.Map(Pixel, aData, DestMD);
6051     end;
6052   end;
6053
6054 begin
6055   result        := false;
6056   BmpFormat     := tfEmpty;
6057   SpecialFormat := nil;
6058   LineBuf       := nil;
6059   SourceMD      := nil;
6060   DestMD        := nil;
6061
6062   // Header
6063   StartPos := aStream.Position;
6064   aStream.Read(Header, SizeOf(Header));
6065
6066   if Header.bfType = BMP_MAGIC then begin
6067     try try
6068       BmpFormat        := ReadInfo(Info, Mask);
6069       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6070       if not Assigned(SpecialFormat) then
6071         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6072       aStream.Position := StartPos + Header.bfOffBits;
6073
6074       if (BmpFormat <> tfEmpty) then begin
6075         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6076         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6077         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6078         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6079
6080         //get Memory
6081         DestMD    := FormatDesc.CreateMappingData;
6082         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6083         GetMem(ImageData, ImageSize);
6084         if Assigned(SpecialFormat) then begin
6085           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6086           SourceMD := SpecialFormat.CreateMappingData;
6087         end;
6088
6089         //read Data
6090         try try
6091           FillChar(ImageData^, ImageSize, $FF);
6092           TmpData := ImageData;
6093           if (Info.biHeight > 0) then
6094             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6095           for i := 0 to Abs(Info.biHeight)-1 do begin
6096             if Assigned(SpecialFormat) then
6097               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6098             else
6099               aStream.Read(TmpData^, wbLineSize);   //else only read data
6100             if (Info.biHeight > 0) then
6101               dec(TmpData, wbLineSize)
6102             else
6103               inc(TmpData, wbLineSize);
6104             aStream.Read(PaddingBuff, Padding);
6105           end;
6106           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
6107           result := true;
6108         finally
6109           if Assigned(LineBuf) then
6110             FreeMem(LineBuf);
6111           if Assigned(SourceMD) then
6112             SpecialFormat.FreeMappingData(SourceMD);
6113           FormatDesc.FreeMappingData(DestMD);
6114         end;
6115         except
6116           FreeMem(ImageData);
6117           raise;
6118         end;
6119       end else
6120         raise EglBitmapException.Create('LoadBMP - No suitable format found');
6121     except
6122       aStream.Position := StartPos;
6123       raise;
6124     end;
6125     finally
6126       FreeAndNil(SpecialFormat);
6127     end;
6128   end
6129     else aStream.Position := StartPos;
6130 end;
6131
6132 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6133 procedure TglBitmap.SaveBMP(const aStream: TStream);
6134 var
6135   Header: TBMPHeader;
6136   Info: TBMPInfo;
6137   pData, pTemp: pByte;
6138
6139   PixelFormat: TglBitmapPixelData;
6140   FormatDesc: TFormatDescriptor;
6141   ImageSize, LineSize, Padding, LineIdx, ColorIdx: Integer;
6142   Temp, RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6143
6144   PaddingBuff: Cardinal;
6145
6146   function GetLineWidth : Integer;
6147   begin
6148     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6149   end;
6150
6151 begin
6152   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6153     raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
6154
6155   ImageSize := TFormatDescriptor.Get(Format).GetSize(Dimension);
6156
6157   Header.bfType      := BMP_MAGIC;
6158   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6159   Header.bfReserved1 := 0;
6160   Header.bfReserved2 := 0;
6161   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6162
6163   FillChar(Info, SizeOf(Info), 0);
6164   Info.biSize        := SizeOf(Info);
6165   Info.biWidth       := Width;
6166   Info.biHeight      := Height;
6167   Info.biPlanes      := 1;
6168   Info.biCompression := BMP_COMP_RGB;
6169   Info.biSizeImage   := ImageSize;
6170   case Format of
6171     tfR3G3B2, tfLuminance8: begin
6172       Info.biBitCount  :=  8;
6173       Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal);
6174     end;
6175
6176     tfRGB5, tfRGB5A1, tfR5G6B5, tfRGB4, tfRGBA4,
6177     tfBGR5, tfBGR5A1, tfB5G6R5, tfBGR4, tfBGRA4: begin
6178       Info.biBitCount    := 16;
6179       Info.biCompression := BMP_COMP_BITFIELDS;
6180     end;
6181
6182     tfBGR8, tfRGB8: begin
6183       Info.biBitCount := 24;
6184     end;
6185
6186     tfRGB10, tfRGB10A2, tfRGBA8,
6187     tfBGR10, tfBGR10A2, tfBGRA8: begin
6188       Info.biBitCount    := 32;
6189       Info.biCompression := BMP_COMP_BITFIELDS;
6190     end;
6191   else
6192     raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
6193   end;
6194   Info.biXPelsPerMeter := 2835;
6195   Info.biYPelsPerMeter := 2835;
6196
6197   // prepare bitmasks
6198   if Info.biCompression = BMP_COMP_BITFIELDS then begin
6199     Info.biSize      := Info.biSize      + 4 * SizeOf(Cardinal);
6200     Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
6201     Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6202
6203     FormatDesc := TFormatDescriptor.Get(Format);
6204     RedMask   := FormatDesc.RedMask;
6205     GreenMask := FormatDesc.GreenMask;
6206     BlueMask  := FormatDesc.BlueMask;
6207     AlphaMask := FormatDesc.AlphaMask;
6208   end;
6209
6210   // headers
6211   aStream.Write(Header, SizeOf(Header));
6212   aStream.Write(Info, SizeOf(Info));
6213
6214   // colortable
6215   if Info.biBitCount = 8 then begin
6216     Temp := 0;
6217     for ColorIdx := Low(Byte) to High(Byte) do begin
6218       aStream.Write(Temp, 4);
6219       Temp := Temp + $00010101;
6220     end;
6221   end;
6222
6223   // bitmasks
6224   if Info.biCompression = BMP_COMP_BITFIELDS then begin
6225     aStream.Write(RedMask,   SizeOf(Cardinal));
6226     aStream.Write(GreenMask, SizeOf(Cardinal));
6227     aStream.Write(BlueMask,  SizeOf(Cardinal));
6228     aStream.Write(AlphaMask, SizeOf(Cardinal));
6229   end;
6230
6231   // image data
6232   LineSize := Trunc(Width * TFormatDescriptor.Get(Format).PixelSize);
6233   Padding := GetLineWidth - LineSize;
6234   PaddingBuff := 0;
6235
6236   pData := Data;
6237   Inc(pData, (Height -1) * LineSize);
6238
6239   // prepare row buffer. But only for RGB because RGBA supports color masks
6240   // so it's possible to change color within the image.
6241   if (Format = tfRGB8) then
6242     GetMem(pTemp, fRowSize)
6243   else
6244     pTemp := nil;
6245
6246   try
6247     // write image data
6248     for LineIdx := 0 to Height - 1 do begin
6249       // preparing row
6250       if Format = tfRGB8 then begin
6251         Move(pData^, pTemp^, fRowSize);
6252         SwapRGB(pTemp, Width, false);
6253       end else
6254         pTemp := pData;
6255       aStream.Write(pTemp^, LineSize);
6256       Dec(pData, LineSize);
6257       if Padding > 0 then
6258         aStream.Write(PaddingBuff, Padding);
6259     end;
6260   finally
6261     // destroy row buffer
6262     if Format = tfRGB8 then
6263       FreeMem(pTemp);
6264   end;
6265 end;
6266
6267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6268 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6269 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6270 type
6271   TTGAHeader = packed record
6272     ImageID: Byte;
6273     ColorMapType: Byte;
6274     ImageType: Byte;
6275     ColorMapSpec: Array[0..4] of Byte;
6276     OrigX: Word;
6277     OrigY: Word;
6278     Width: Word;
6279     Height: Word;
6280     Bpp: Byte;
6281     ImageDes: Byte;
6282   end;
6283
6284 const
6285   TGA_UNCOMPRESSED_RGB = 2;
6286   TGA_UNCOMPRESSED_GRAY = 3;
6287   TGA_COMPRESSED_RGB = 10;
6288   TGA_COMPRESSED_GRAY = 11;
6289
6290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6291 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6292 var
6293   Header: TTGAHeader;
6294   NewImage, pData: PByte;
6295   StreamPos: Int64;
6296   PixelSize, LineSize, YStart, YEnd, YInc: Integer;
6297   Format: TglBitmapFormat;
6298
6299 const
6300   CACHE_SIZE = $4000;
6301
6302   ////////////////////////////////////////////////////////////////////////////////////////
6303   procedure ReadUncompressed;
6304   var
6305     RowSize: Integer;
6306   begin
6307     RowSize := Header.Width * PixelSize;
6308     // copy line by line
6309     while YStart <> YEnd + YInc do begin
6310       pData := NewImage;
6311       Inc(pData, YStart * LineSize);
6312       aStream.Read(pData^, RowSize);
6313       Inc(YStart, YInc);
6314     end;
6315   end;
6316
6317   ////////////////////////////////////////////////////////////////////////////////////////
6318   procedure ReadCompressed;
6319   var
6320     HeaderWidth, HeaderHeight: Integer;
6321     LinePixelsRead, ImgPixelsRead, ImgPixelsToRead: Integer;
6322
6323     Cache: PByte;
6324     CacheSize, CachePos: Integer;
6325
6326     Temp: Byte;
6327     TempBuf: Array [0..15] of Byte;
6328
6329     PixelRepeat: Boolean;
6330     PixelToRead, TempPixels: Integer;
6331
6332     /////////////////////////////////////////////////////////////////
6333     procedure CheckLine;
6334     begin
6335       if LinePixelsRead >= HeaderWidth then begin
6336         LinePixelsRead := 0;
6337         pData := NewImage;
6338         Inc(YStart, YInc);
6339         Inc(pData, YStart * LineSize);
6340       end;
6341     end;
6342
6343     /////////////////////////////////////////////////////////////////
6344     procedure CachedRead(out Buffer; Count: Integer);
6345     var
6346       BytesRead: Integer;
6347     begin
6348       if (CachePos + Count) > CacheSize then begin
6349         BytesRead := 0;
6350
6351         // Read Data
6352         if CacheSize - CachePos > 0 then begin
6353           BytesRead := CacheSize - CachePos;
6354           Move(pByteArray(Cache)^[CachePos], Buffer, BytesRead);
6355           Inc(CachePos, BytesRead);
6356         end;
6357
6358         // Reload Data
6359         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6360         aStream.Read(Cache^, CacheSize);
6361         CachePos := 0;
6362
6363         // Read else
6364         if Count - BytesRead > 0 then begin
6365           Move(pByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6366           Inc(CachePos, Count - BytesRead);
6367         end;
6368       end else begin
6369         Move(pByteArray(Cache)^[CachePos], Buffer, Count);
6370         Inc(CachePos, Count);
6371       end;
6372     end;
6373
6374   begin
6375     CacheSize := 0;
6376     CachePos := 0;
6377
6378     HeaderWidth := Header.Width;
6379     HeaderHeight := Header.Height;
6380
6381     GetMem(Cache, CACHE_SIZE); // 16K Buffer
6382     try
6383       ImgPixelsToRead := HeaderWidth * HeaderHeight;
6384       ImgPixelsRead := 0;
6385       LinePixelsRead := 0;
6386
6387       pData := NewImage;
6388       Inc(pData, YStart * LineSize);
6389
6390       // Read until all Pixels
6391       repeat
6392         CachedRead(Temp, 1);
6393
6394         PixelRepeat := Temp and $80 > 0;
6395         PixelToRead := (Temp and $7F) + 1;
6396
6397         Inc(ImgPixelsRead, PixelToRead);
6398
6399         if PixelRepeat then begin
6400           // repeat one pixel x times
6401           CachedRead(TempBuf[0], PixelSize);
6402
6403           // repeat Pixel
6404           while PixelToRead > 0 do begin
6405             CheckLine;
6406
6407             TempPixels := HeaderWidth - LinePixelsRead;
6408             if PixelToRead < TempPixels then
6409               TempPixels := PixelToRead;
6410
6411             Inc(LinePixelsRead, TempPixels);
6412             Dec(PixelToRead, TempPixels);
6413
6414             while TempPixels > 0 do begin
6415               case PixelSize of
6416                 1: begin
6417                   pData^ := TempBuf[0];
6418                   Inc(pData);
6419                 end;
6420                 2: begin
6421                   pWord(pData)^ := pWord(@TempBuf[0])^;
6422                   Inc(pData, 2);
6423                 end;
6424                 3: begin
6425                   pWord(pData)^ := pWord(@TempBuf[0])^;
6426                   Inc(pData, 2);
6427                   pData^ := TempBuf[2];
6428                   Inc(pData);
6429                 end;
6430                 4: begin
6431                   pDWord(pData)^ := pDWord(@TempBuf[0])^;
6432                   Inc(pData, 4);
6433                 end;
6434               end;
6435               Dec(TempPixels);
6436             end;
6437           end;
6438         end else begin
6439           // copy x pixels
6440           while PixelToRead > 0 do begin
6441             CheckLine;
6442             TempPixels := HeaderWidth - LinePixelsRead;
6443             if PixelToRead < TempPixels then
6444               TempPixels := PixelToRead;
6445             CachedRead(pData^, PixelSize * TempPixels);
6446             Inc(pData, PixelSize * TempPixels);
6447             Inc(LinePixelsRead, TempPixels);
6448             Dec(PixelToRead, TempPixels);
6449           end;
6450         end;
6451       until ImgPixelsRead >= ImgPixelsToRead;
6452     finally
6453       FreeMem(Cache)
6454     end;
6455   end;
6456
6457 begin
6458   result := false;
6459
6460   // reading header to test file and set cursor back to begin
6461   StreamPos := aStream.Position;
6462   aStream.Read(Header, SizeOf(Header));
6463
6464   // no colormapped files
6465   if (Header.ColorMapType = 0) then begin
6466     if Header.ImageType in [TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY] then begin
6467       case Header.Bpp of
6468         //TODO 8: Format := tfAlpha8;
6469         16: Format := tfLuminance8Alpha8;
6470         24: Format := tfBGR8;
6471         32: Format := tfBGRA8;
6472       else
6473         raise EglBitmapException.Create('LoadTga - unsupported BitsPerPixel found.');
6474       end;
6475
6476       // skip image ID
6477       if Header.ImageID <> 0 then
6478         aStream.Position := aStream.Position + Header.ImageID;
6479
6480       PixelSize := TFormatDescriptor.Get(Format).GetSize(1, 1);
6481       LineSize  := Trunc(Header.Width * PixelSize);
6482
6483       GetMem(NewImage, LineSize * Header.Height);
6484       try
6485         // Row direction
6486         if (Header.ImageDes and $20 > 0) then begin
6487           YStart := 0;
6488           YEnd := Header.Height -1;
6489           YInc := 1;
6490         end else begin
6491           YStart := Header.Height -1;
6492           YEnd := 0;
6493           YInc := -1;
6494         end;
6495
6496         // Read Image
6497         case Header.ImageType of
6498           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
6499             ReadUncompressed;
6500           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
6501             ReadCompressed;
6502         end;
6503
6504         SetDataPointer(NewImage, Format, Header.Width, Header.Height);
6505         result := true;
6506       except
6507         FreeMem(NewImage);
6508         raise;
6509       end;
6510     end
6511       else aStream.Position := StreamPos;
6512   end
6513     else aStream.Position := StreamPos;
6514 end;
6515
6516 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6517 procedure TglBitmap.SaveTGA(const aStream: TStream);
6518 var
6519   Header: TTGAHeader;
6520   Size: Integer;
6521   pTemp: pByte;
6522   FormatDesc: TFormatDescriptor;
6523
6524   procedure ConvertData(pTemp: pByte);
6525   var
6526     Idx, PixelSize: Integer;
6527     Temp: byte;
6528   begin
6529     PixelSize := fPixelSize;
6530     for Idx := 1 to Height * Width do begin
6531       Temp := pByteArray(pTemp)^[2];
6532       pByteArray(pTemp)^[2] := pByteArray(pTemp)^[0];
6533       pByteArray(pTemp)^[0] := Temp;
6534       Inc(pTemp, PixelSize);
6535     end;
6536   end;
6537
6538 begin
6539   if not (ftTGA in FormatGetSupportedFiles(Format)) then
6540     raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);
6541
6542   FillChar(Header, SizeOf(Header), 0);
6543   case Format of
6544     //TODO ifAlpha8, ifLuminance8, ifDepth8: begin
6545     tfLuminance8: begin
6546       Header.ImageType := TGA_UNCOMPRESSED_GRAY;
6547       Header.Bpp := 8;
6548     end;
6549     tfLuminance8Alpha8: begin
6550       Header.ImageType := TGA_UNCOMPRESSED_GRAY;
6551       Header.Bpp := 16;
6552     end;
6553     tfRGB8, tfBGR8: begin
6554       Header.ImageType := TGA_UNCOMPRESSED_RGB;
6555       Header.Bpp := 24;
6556     end;
6557     tfRGBA8, tfBGRA8: begin
6558       Header.ImageType := TGA_UNCOMPRESSED_RGB;
6559       Header.Bpp := 32;
6560     end;
6561   else
6562     raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);
6563   end;
6564
6565   Header.Width    := Width;
6566   Header.Height   := Height;
6567   Header.ImageDes := $20;
6568   FormatDesc      := TFormatDescriptor.Get(Format);
6569
6570   if FormatDesc.HasAlpha then
6571     Header.ImageDes := Header.ImageDes or $08;
6572   aStream.Write(Header, SizeOf(Header));
6573
6574   // convert RGB(A) to BGR(A)
6575   Size := FormatDesc.GetSize(Dimension);
6576   if Format in [tfRGB8, tfRGBA8] then begin
6577     GetMem(pTemp, Size);
6578   end else
6579     pTemp := Data;
6580
6581   try
6582     // convert data
6583     if Format in [tfRGB8, tfRGBA8] then begin
6584       Move(Data^, pTemp^, Size);
6585       ConvertData(pTemp);
6586     end;
6587
6588     // write data
6589     aStream.Write(pTemp^, Size);
6590   finally
6591     // free tempdata
6592     if Format in [tfRGB8, tfRGBA8] then
6593       FreeMem(pTemp);
6594   end;
6595 end;
6596
6597 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6598 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6599 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6600 const
6601   DDS_MAGIC                   = $20534444;
6602
6603   // DDS_header.dwFlags
6604   DDSD_CAPS                   = $00000001;
6605   DDSD_HEIGHT                 = $00000002;
6606   DDSD_WIDTH                  = $00000004;
6607   DDSD_PITCH                  = $00000008;
6608   DDSD_PIXELFORMAT            = $00001000;
6609   DDSD_MIPMAPCOUNT            = $00020000;
6610   DDSD_LINEARSIZE             = $00080000;
6611   DDSD_DEPTH                  = $00800000;
6612
6613   // DDS_header.sPixelFormat.dwFlags
6614   DDPF_ALPHAPIXELS            = $00000001;
6615   DDPF_FOURCC                 = $00000004;
6616   DDPF_INDEXED                = $00000020;
6617   DDPF_RGB                    = $00000040;
6618
6619   // DDS_header.sCaps.dwCaps1
6620   DDSCAPS_COMPLEX             = $00000008;
6621   DDSCAPS_TEXTURE             = $00001000;
6622   DDSCAPS_MIPMAP              = $00400000;
6623
6624   // DDS_header.sCaps.dwCaps2
6625   DDSCAPS2_CUBEMAP            = $00000200;
6626   DDSCAPS2_CUBEMAP_POSITIVEX  = $00000400;
6627   DDSCAPS2_CUBEMAP_NEGATIVEX  = $00000800;
6628   DDSCAPS2_CUBEMAP_POSITIVEY  = $00001000;
6629   DDSCAPS2_CUBEMAP_NEGATIVEY  = $00002000;
6630   DDSCAPS2_CUBEMAP_POSITIVEZ  = $00004000;
6631   DDSCAPS2_CUBEMAP_NEGATIVEZ  = $00008000;
6632   DDSCAPS2_VOLUME             = $00200000;
6633
6634   D3DFMT_DXT1                 = $31545844;
6635   D3DFMT_DXT3                 = $33545844;
6636   D3DFMT_DXT5                 = $35545844;
6637
6638 type
6639   TDDSPixelFormat = packed record
6640     dwSize: Cardinal;
6641     dwFlags: Cardinal;
6642     dwFourCC: Cardinal;
6643     dwRGBBitCount: Cardinal;
6644     dwRBitMask: Cardinal;
6645     dwGBitMask: Cardinal;
6646     dwBBitMask: Cardinal;
6647     dwABitMask: Cardinal;
6648   end;
6649
6650   TDDSCaps = packed record
6651     dwCaps1: Cardinal;
6652     dwCaps2: Cardinal;
6653     dwDDSX: Cardinal;
6654     dwReserved: Cardinal;
6655   end;
6656
6657   TDDSHeader = packed record
6658     dwMagic: Cardinal;
6659     dwSize: Cardinal;
6660     dwFlags: Cardinal;
6661     dwHeight: Cardinal;
6662     dwWidth: Cardinal;
6663     dwPitchOrLinearSize: Cardinal;
6664     dwDepth: Cardinal;
6665     dwMipMapCount: Cardinal;
6666     dwReserved: array[0..10] of Cardinal;
6667     PixelFormat: TDDSPixelFormat;
6668     Caps: TDDSCaps;
6669     dwReserved2: Cardinal;
6670   end;
6671
6672 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6673 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
6674 var
6675   Header: TDDSHeader;
6676   StreamPos: Int64;
6677   Y, LineSize: Cardinal;
6678   RowSize: Cardinal;
6679   NewImage, pData: pByte;
6680   ddsFormat: TglBitmapFormat;
6681
6682   function RaiseEx : Exception;
6683   begin
6684     result := EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
6685   end;
6686
6687   function GetDDSFormat: TglBitmapFormat;
6688   begin
6689     with Header.PixelFormat do begin
6690       // Compresses
6691       if (dwFlags and DDPF_FOURCC) > 0 then begin
6692         (* TODO
6693         case Header.PixelFormat.dwFourCC of
6694           D3DFMT_DXT1: result := ifDXT1;
6695           D3DFMT_DXT3: result := ifDXT3;
6696           D3DFMT_DXT5: result := ifDXT5;
6697         else
6698           raise RaiseEx;
6699         end;
6700         *)
6701         raise RaiseEx;
6702       end else
6703
6704       // RGB
6705       if (dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
6706         case dwRGBBitCount of
6707           8: begin
6708             (* TODO if dwFlags and DDPF_ALPHAPIXELS > 0 then
6709               result := tfAlpha
6710             else
6711             *)
6712               result := tfLuminance8;
6713           end;
6714           16: begin
6715             if dwFlags and DDPF_ALPHAPIXELS > 0 then begin
6716               // Alpha
6717               case CountSetBits(dwRBitMask) of
6718                 5: result := tfRGB5A1;
6719                 //TODO 4: result := tfRGBA4;
6720               else
6721                 result := tfLuminance8Alpha8;
6722               end;
6723             end else begin
6724               // no Alpha
6725               //TODO result := ifR5G6B5;
6726               raise RaiseEx;
6727             end;
6728           end;
6729           24: begin
6730             if dwRBitMask > dwBBitMask then
6731               result := tfBGR8
6732             else
6733               result := tfRGB8;
6734           end;
6735         32: begin
6736             if CountSetBits(dwRBitMask) = 10 then
6737               //TODO result := tfRGB10A2
6738               raise RaiseEx
6739             else
6740
6741             if dwRBitMask > dwBBitMask then
6742               result := tfBGRA8
6743             else
6744               result := tfRGBA8;
6745           end;
6746         else
6747           raise RaiseEx;
6748         end;
6749       end else
6750         raise RaiseEx;
6751     end;
6752   end;
6753
6754 begin
6755   result := false;
6756
6757   // Header
6758   StreamPos := aStream.Position;
6759   aStream.Read(Header, sizeof(Header));
6760
6761   if ((Header.dwMagic <> DDS_MAGIC) or (Header.dwSize <> 124) or
6762      ((Header.dwFlags and DDSD_PIXELFORMAT) = 0) or ((Header.dwFlags and DDSD_CAPS) = 0)) then begin
6763     aStream.Position := StreamPos;
6764     exit;
6765   end;
6766
6767   ddsFormat := GetDDSFormat;
6768   LineSize  := Trunc(Header.dwWidth * TFormatDescriptor.Get(ddsFormat).PixelSize);
6769   GetMem(NewImage, Header.dwHeight * LineSize);
6770   try
6771     pData := NewImage;
6772
6773     // Compressed
6774     if (Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0 then begin
6775       RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
6776       for Y := 0 to Header.dwHeight -1 do begin
6777         aStream.Read(pData^, RowSize);
6778         Inc(pData, LineSize);
6779       end;
6780     end else
6781
6782     // RGB(A)
6783     if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
6784       RowSize := Header.dwPitchOrLinearSize;
6785
6786       for Y := 0 to Header.dwHeight -1 do begin
6787         aStream.Read(pData^, RowSize);
6788         Inc(pData, LineSize);
6789       end;
6790     end else
6791       raise RaiseEx;
6792
6793     SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
6794     result := true;
6795   except
6796     FreeMem(NewImage);
6797     raise;
6798   end;
6799 end;
6800
6801 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6802 procedure TglBitmap.SaveDDS(const aStream: TStream);
6803 var
6804   Header: TDDSHeader;
6805   Pix: TglBitmapPixelData;
6806   FormatDesc: TFormatDescriptor;
6807 begin
6808   //if not FormatIsUncompressed(InternalFormat) then
6809   //  raise EglBitmapUnsupportedFormatFormat.Create('SaveDDS - ' + UNSUPPORTED_FORMAT);
6810
6811   (* TODO if Format = tfAlpha8 then
6812     FORMAT_DESCRIPTORS[tfLuminance8].PreparePixel(Pix);
6813   else    *)
6814     TFormatDescriptor.Get(Format).PreparePixel(Pix);
6815
6816   // Generell
6817   FillChar(Header, SizeOf(Header), 0);
6818   Header.dwMagic := DDS_MAGIC;
6819   Header.dwSize  := 124;
6820   Header.dwFlags := DDSD_PITCH or DDSD_CAPS or DDSD_PIXELFORMAT;
6821
6822   if Width > 0 then begin
6823     Header.dwWidth := Width;
6824     Header.dwFlags := Header.dwFlags or DDSD_WIDTH;
6825   end;
6826
6827   if Height > 0 then begin
6828     Header.dwHeight := Height;
6829     Header.dwFlags := Header.dwFlags or DDSD_HEIGHT;
6830   end;
6831
6832   Header.dwPitchOrLinearSize := fRowSize;
6833   Header.dwMipMapCount := 1;
6834
6835   // Caps
6836   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
6837
6838   // Pixelformat
6839   Header.PixelFormat.dwSize  := Sizeof(Header.PixelFormat);
6840   Header.PixelFormat.dwFlags := DDPF_RGB;
6841
6842   (* TODO tfAlpha8
6843   if FORMAT_DESCRIPTORS[Format].HasAlpha and (Format <> tfAlpha8) then
6844     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
6845   *)
6846
6847   FormatDesc := TFormatDescriptor.Get(Format);
6848   Header.PixelFormat.dwRGBBitCount  := Trunc(FormatDesc.PixelSize * 8);
6849   Header.PixelFormat.dwRBitMask     := FormatDesc.RedMask;
6850   Header.PixelFormat.dwGBitMask     := FormatDesc.GreenMask;
6851   Header.PixelFormat.dwBBitMask     := FormatDesc.BlueMask;
6852   Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
6853
6854   aStream.Write(Header, SizeOf(Header));
6855   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
6856 end;
6857
6858 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6859 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6860 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6861 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
6862 begin
6863   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
6864     result := fLines[aIndex]
6865   else
6866     result := nil;
6867 end;
6868
6869 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6870 procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
6871   const aWidth: Integer; const aHeight: Integer);
6872 var
6873   Idx, LineWidth: Integer;
6874 begin
6875   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
6876
6877   //TODO compression
6878   if {FormatIsUncompressed(Format)} true then begin
6879     (* TODO PixelFuncs
6880     fGetPixelFunc := GetPixel2DUnmap;
6881     fSetPixelFunc := SetPixel2DUnmap;
6882     *)
6883     // Assigning Data
6884     if Assigned(Data) then begin
6885       SetLength(fLines, GetHeight);
6886       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
6887
6888       for Idx := 0 to GetHeight -1 do begin
6889         fLines[Idx] := Data;
6890         Inc(fLines[Idx], Idx * LineWidth);
6891       end;
6892     end
6893       else SetLength(fLines, 0);
6894   end else begin
6895     (*
6896     SetLength(fLines, 0);
6897
6898     fSetPixelFunc := nil;
6899
6900     case Format of
6901       ifDXT1:
6902         fGetPixelFunc := GetPixel2DDXT1;
6903       ifDXT3:
6904         fGetPixelFunc := GetPixel2DDXT3;
6905       ifDXT5:
6906         fGetPixelFunc := GetPixel2DDXT5;
6907       else
6908         fGetPixelFunc := nil;
6909     end;
6910     *)
6911   end;
6912 end;
6913
6914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6915 procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
6916 var
6917   FormatDesc: TFormatDescriptor;
6918 begin
6919   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
6920
6921   (* TODO compression
6922   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
6923     glCompressedTexImage2D(Target, 0, InternalFormat, Width, Height, 0, Trunc(Width * Height * FormatGetSize(Self.InternalFormat)), Data)
6924   else
6925   *)
6926
6927   FormatDesc := TFormatDescriptor.Get(Format);
6928   if aBuildWithGlu then
6929     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
6930       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
6931   else
6932     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
6933       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
6934
6935   // Freigeben
6936   if (FreeDataAfterGenTexture) then
6937     FreeData;
6938 end;
6939
6940 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6941 procedure TglBitmap2D.AfterConstruction;
6942 begin
6943   inherited;
6944   Target := GL_TEXTURE_2D;
6945 end;
6946
6947 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6948 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
6949 var
6950   Temp: pByte;
6951   Size, w, h: Integer;
6952   FormatDesc: TFormatDescriptor;
6953 begin
6954   (* TODO compression
6955   if not FormatIsUncompressed(Format) then
6956     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_FORMAT);
6957   *)
6958
6959   w := aRight  - aLeft;
6960   h := aBottom - aTop;
6961   FormatDesc   := TFormatDescriptor.Get(Format);
6962   Size         := FormatDesc.GetSize(w, h);
6963   GetMem(Temp, Size);
6964   try
6965     glPixelStorei(GL_PACK_ALIGNMENT, 1);
6966     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
6967     SetDataPointer(Temp, Format, w, h);
6968     FlipVert;
6969   except
6970     FreeMem(Temp);
6971     raise;
6972   end;
6973 end;
6974
6975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6976 procedure TglBitmap2D.GetDataFromTexture;
6977 var
6978   Temp: PByte;
6979   TempWidth, TempHeight: Integer;
6980   TempType, TempIntFormat: Cardinal;
6981   IntFormat, f: TglBitmapFormat;
6982   FormatDesc: TFormatDescriptor;
6983 begin
6984   Bind;
6985
6986   // Request Data
6987   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
6988   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
6989   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
6990
6991   IntFormat := tfEmpty;
6992   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do
6993     if (TFormatDescriptor.Get(f).glInternalFormat = TempIntFormat) then begin
6994       IntFormat := FormatDesc.Format;
6995       break;
6996     end;
6997
6998   // Getting data from OpenGL
6999   FormatDesc := TFormatDescriptor.Get(IntFormat);
7000   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7001   try
7002     (* TODO Compression
7003     if FormatIsCompressed(IntFormat) and (GL_VERSION_1_3 or GL_ARB_texture_compression) then
7004       glGetCompressedTexImage(Target, 0, Temp)
7005     else
7006     *)
7007     glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7008     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
7009   except
7010     FreeMem(Temp);
7011     raise;
7012   end;
7013 end;
7014
7015 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7016 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7017 var
7018   BuildWithGlu, PotTex, TexRec: Boolean;
7019   TexSize: Integer;
7020 begin
7021   if Assigned(Data) then begin
7022     // Check Texture Size
7023     if (aTestTextureSize) then begin
7024       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7025
7026       if ((Height > TexSize) or (Width > TexSize)) then
7027         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7028
7029       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7030       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE_ARB);
7031
7032       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7033         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7034     end;
7035
7036     CreateId;
7037     SetupParameters(BuildWithGlu);
7038     UploadData(Target, BuildWithGlu);
7039     glAreTexturesResident(1, @fID, @fIsResident);
7040   end;
7041 end;
7042
7043 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7044 function TglBitmap2D.FlipHorz: Boolean;
7045 var
7046   Col, Row: Integer;
7047   TempDestData, DestData, SourceData: PByte;
7048   ImgSize: Integer;
7049 begin
7050   result := inherited FlipHorz;
7051   if Assigned(Data) then begin
7052     SourceData := Data;
7053     ImgSize := Height * fRowSize;
7054     GetMem(DestData, ImgSize);
7055     try
7056       TempDestData := DestData;
7057       Dec(TempDestData, fRowSize + fPixelSize);
7058       for Row := 0 to Height -1 do begin
7059         Inc(TempDestData, fRowSize * 2);
7060         for Col := 0 to Width -1 do begin
7061           Move(SourceData^, TempDestData^, fPixelSize);
7062           Inc(SourceData, fPixelSize);
7063           Dec(TempDestData, fPixelSize);
7064         end;
7065       end;
7066       SetDataPointer(DestData, Format);
7067       result := true;
7068     except
7069       FreeMem(DestData);
7070       raise;
7071     end;
7072   end;
7073 end;
7074
7075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7076 function TglBitmap2D.FlipVert: Boolean;
7077 var
7078   Row: Integer;
7079   TempDestData, DestData, SourceData: PByte;
7080 begin
7081   result := inherited FlipVert;
7082   if Assigned(Data) then begin
7083     SourceData := Data;
7084     GetMem(DestData, Height * fRowSize);
7085     try
7086       TempDestData := DestData;
7087       Inc(TempDestData, Width * (Height -1) * fPixelSize);
7088       for Row := 0 to Height -1 do begin
7089         Move(SourceData^, TempDestData^, fRowSize);
7090         Dec(TempDestData, fRowSize);
7091         Inc(SourceData, fRowSize);
7092       end;
7093       SetDataPointer(DestData, Format);
7094       result := true;
7095     except
7096       FreeMem(DestData);
7097       raise;
7098     end;
7099   end;
7100 end;
7101
7102 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7103 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7105 type
7106   TMatrixItem = record
7107     X, Y: Integer;
7108     W: Single;
7109   end;
7110
7111   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7112   TglBitmapToNormalMapRec = Record
7113     Scale: Single;
7114     Heights: array of Single;
7115     MatrixU : array of TMatrixItem;
7116     MatrixV : array of TMatrixItem;
7117   end;
7118
7119 const
7120   ONE_OVER_255 = 1 / 255;
7121
7122   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7123 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7124 var
7125   Val: Single;
7126 begin
7127   with FuncRec do begin
7128     Val :=
7129       Source.Data.r * LUMINANCE_WEIGHT_R +
7130       Source.Data.g * LUMINANCE_WEIGHT_G +
7131       Source.Data.b * LUMINANCE_WEIGHT_B;
7132     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7133   end;
7134 end;
7135
7136 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7137 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7138 begin
7139   with FuncRec do
7140     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7141 end;
7142
7143 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7144 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7145 type
7146   TVec = Array[0..2] of Single;
7147 var
7148   Idx: Integer;
7149   du, dv: Double;
7150   Len: Single;
7151   Vec: TVec;
7152
7153   function GetHeight(X, Y: Integer): Single;
7154   begin
7155     with FuncRec do begin
7156       X := Max(0, Min(Size.X -1, X));
7157       Y := Max(0, Min(Size.Y -1, Y));
7158       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7159     end;
7160   end;
7161
7162 begin
7163   with FuncRec do begin
7164     with PglBitmapToNormalMapRec(Args)^ do begin
7165       du := 0;
7166       for Idx := Low(MatrixU) to High(MatrixU) do
7167         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7168
7169       dv := 0;
7170       for Idx := Low(MatrixU) to High(MatrixU) do
7171         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7172
7173       Vec[0] := -du * Scale;
7174       Vec[1] := -dv * Scale;
7175       Vec[2] := 1;
7176     end;
7177
7178     // Normalize
7179     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7180     if Len <> 0 then begin
7181       Vec[0] := Vec[0] * Len;
7182       Vec[1] := Vec[1] * Len;
7183       Vec[2] := Vec[2] * Len;
7184     end;
7185
7186     // Farbe zuweisem
7187     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7188     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7189     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7190   end;
7191 end;
7192
7193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7194 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7195 var
7196   Rec: TglBitmapToNormalMapRec;
7197
7198   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7199   begin
7200     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7201       Matrix[Index].X := X;
7202       Matrix[Index].Y := Y;
7203       Matrix[Index].W := W;
7204     end;
7205   end;
7206
7207 begin
7208   (* TODO Compression
7209   if not FormatIsUncompressed(InternalFormat) then
7210     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT);
7211     *)
7212
7213   if aScale > 100 then
7214     Rec.Scale := 100
7215   else if aScale < -100 then
7216     Rec.Scale := -100
7217   else
7218     Rec.Scale := aScale;
7219
7220   SetLength(Rec.Heights, Width * Height);
7221   try
7222     case aFunc of
7223       nm4Samples: begin
7224         SetLength(Rec.MatrixU, 2);
7225         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7226         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7227
7228         SetLength(Rec.MatrixV, 2);
7229         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7230         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7231       end;
7232
7233       nmSobel: begin
7234         SetLength(Rec.MatrixU, 6);
7235         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7236         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7237         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7238         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7239         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7240         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7241
7242         SetLength(Rec.MatrixV, 6);
7243         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7244         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7245         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7246         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7247         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7248         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7249       end;
7250
7251       nm3x3: begin
7252         SetLength(Rec.MatrixU, 6);
7253         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7254         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7255         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7256         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7257         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7258         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7259
7260         SetLength(Rec.MatrixV, 6);
7261         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7262         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7263         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7264         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7265         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7266         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7267       end;
7268
7269       nm5x5: begin
7270         SetLength(Rec.MatrixU, 20);
7271         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7272         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7273         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7274         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7275         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7276         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7277         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7278         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7279         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7280         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7281         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7282         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7283         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7284         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7285         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7286         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7287         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7288         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7289         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7290         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7291
7292         SetLength(Rec.MatrixV, 20);
7293         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7294         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7295         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7296         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7297         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7298         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7299         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7300         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7301         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7302         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7303         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7304         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7305         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7306         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7307         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7308         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7309         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7310         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7311         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7312         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7313       end;
7314     end;
7315
7316     // Daten Sammeln
7317     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7318       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, PtrInt(@Rec))
7319     else
7320       AddFunc(glBitmapToNormalMapPrepareFunc, false, PtrInt(@Rec));
7321     AddFunc(glBitmapToNormalMapFunc, false, PtrInt(@Rec));
7322   finally
7323     SetLength(Rec.Heights, 0);
7324   end;
7325 end;
7326
7327
7328
7329
7330
7331
7332
7333
7334
7335 (*
7336 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
7337 var
7338   pTemp: pByte;
7339   Size: Integer;
7340 begin
7341   if Height > 1 then begin
7342     // extract first line of the data
7343     Size := FormatGetImageSize(glBitmapPosition(Width), Format);
7344     GetMem(pTemp, Size);
7345
7346     Move(Data^, pTemp^, Size);
7347
7348     FreeMem(Data);
7349   end else
7350     pTemp := Data;
7351
7352   // set data pointer
7353   inherited SetDataPointer(pTemp, Format, Width);
7354
7355   if FormatIsUncompressed(Format) then begin
7356     fUnmapFunc := FormatGetUnMapFunc(Format);
7357     fGetPixelFunc := GetPixel1DUnmap;
7358   end;
7359 end;
7360
7361
7362 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
7363 var
7364   pTemp: pByte;
7365 begin
7366   pTemp := Data;
7367   Inc(pTemp, Pos.X * fPixelSize);
7368
7369   fUnmapFunc(pTemp, Pixel);
7370 end;
7371
7372
7373 function TglBitmap1D.FlipHorz: Boolean;
7374 var
7375   Col: Integer;
7376   pTempDest, pDest, pSource: pByte;
7377 begin
7378   result := inherited FlipHorz;
7379
7380   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
7381     pSource := Data;
7382
7383     GetMem(pDest, fRowSize);
7384     try
7385       pTempDest := pDest;
7386
7387       Inc(pTempDest, fRowSize);
7388       for Col := 0 to Width -1 do begin
7389         Move(pSource^, pTempDest^, fPixelSize);
7390
7391         Inc(pSource, fPixelSize);
7392         Dec(pTempDest, fPixelSize);
7393       end;
7394
7395       SetDataPointer(pDest, InternalFormat);
7396
7397       result := true;
7398     finally
7399       FreeMem(pDest);
7400     end;
7401   end;
7402 end;
7403
7404
7405 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
7406 begin
7407   // Upload data
7408   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
7409     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
7410   else
7411
7412   // Upload data
7413   if BuildWithGlu then
7414     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
7415   else
7416     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
7417
7418   // Freigeben
7419   if (FreeDataAfterGenTexture) then
7420     FreeData;
7421 end;
7422
7423
7424 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
7425 var
7426   BuildWithGlu, TexRec: Boolean;
7427   glFormat, glInternalFormat, glType: Cardinal;
7428   TexSize: Integer;
7429 begin
7430   if Assigned(Data) then begin
7431     // Check Texture Size
7432     if (TestTextureSize) then begin
7433       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7434
7435       if (Width > TexSize) then
7436         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7437
7438       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7439                 (Target = GL_TEXTURE_RECTANGLE_ARB);
7440
7441       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7442         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7443     end;
7444
7445     CreateId;
7446
7447     SetupParameters(BuildWithGlu);
7448     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
7449
7450     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
7451
7452     // Infos sammeln
7453     glAreTexturesResident(1, @fID, @fIsResident);
7454   end;
7455 end;
7456
7457
7458 procedure TglBitmap1D.AfterConstruction;
7459 begin
7460   inherited;
7461
7462   Target := GL_TEXTURE_1D;
7463 end;
7464
7465
7466 { TglBitmapCubeMap }
7467
7468 procedure TglBitmapCubeMap.AfterConstruction;
7469 begin
7470   inherited;
7471
7472   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
7473     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
7474
7475   SetWrap; // set all to GL_CLAMP_TO_EDGE
7476   Target := GL_TEXTURE_CUBE_MAP;
7477   fGenMode := GL_REFLECTION_MAP;
7478 end;
7479
7480
7481 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
7482 begin
7483   inherited Bind (EnableTextureUnit);
7484
7485   if EnableTexCoordsGen then begin
7486     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
7487     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
7488     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
7489     glEnable(GL_TEXTURE_GEN_S);
7490     glEnable(GL_TEXTURE_GEN_T);
7491     glEnable(GL_TEXTURE_GEN_R);
7492   end;
7493 end;
7494
7495
7496 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
7497 var
7498   glFormat, glInternalFormat, glType: Cardinal;
7499   BuildWithGlu: Boolean;
7500   TexSize: Integer;
7501 begin
7502   // Check Texture Size
7503   if (TestTextureSize) then begin
7504     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
7505
7506     if ((Height > TexSize) or (Width > TexSize)) then
7507       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
7508
7509     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
7510       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
7511   end;
7512
7513   // create Texture
7514   if ID = 0 then begin
7515     CreateID;
7516     SetupParameters(BuildWithGlu);
7517   end;
7518
7519   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
7520
7521   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
7522 end;
7523
7524
7525 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
7526 begin
7527   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
7528 end;
7529
7530
7531 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
7532   DisableTextureUnit: Boolean);
7533 begin
7534   inherited Unbind (DisableTextureUnit);
7535
7536   if DisableTexCoordsGen then begin
7537     glDisable(GL_TEXTURE_GEN_S);
7538     glDisable(GL_TEXTURE_GEN_T);
7539     glDisable(GL_TEXTURE_GEN_R);
7540   end;
7541 end;
7542
7543
7544 { TglBitmapNormalMap }
7545
7546 type
7547   TVec = Array[0..2] of Single;
7548   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7549
7550   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
7551   TglBitmapNormalMapRec = record
7552     HalfSize : Integer;
7553     Func: TglBitmapNormalMapGetVectorFunc;
7554   end;
7555
7556
7557 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7558 begin
7559   Vec[0] := HalfSize;
7560   Vec[1] := - (Position.Y + 0.5 - HalfSize);
7561   Vec[2] := - (Position.X + 0.5 - HalfSize);
7562 end;
7563
7564
7565 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7566 begin
7567   Vec[0] := - HalfSize;
7568   Vec[1] := - (Position.Y + 0.5 - HalfSize);
7569   Vec[2] := Position.X + 0.5 - HalfSize;
7570 end;
7571
7572
7573 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7574 begin
7575   Vec[0] := Position.X + 0.5 - HalfSize;
7576   Vec[1] := HalfSize;
7577   Vec[2] := Position.Y + 0.5 - HalfSize;
7578 end;
7579
7580
7581 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7582 begin
7583   Vec[0] := Position.X + 0.5 - HalfSize;
7584   Vec[1] := - HalfSize;
7585   Vec[2] := - (Position.Y + 0.5 - HalfSize);
7586 end;
7587
7588
7589 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7590 begin
7591   Vec[0] := Position.X + 0.5 - HalfSize;
7592   Vec[1] := - (Position.Y + 0.5 - HalfSize);
7593   Vec[2] := HalfSize;
7594 end;
7595
7596
7597 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7598 begin
7599   Vec[0] := - (Position.X + 0.5 - HalfSize);
7600   Vec[1] := - (Position.Y + 0.5 - HalfSize);
7601   Vec[2] := - HalfSize;
7602 end;
7603
7604
7605 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
7606 var
7607   Vec : TVec;
7608   Len: Single;
7609 begin
7610   with FuncRec do begin
7611     with PglBitmapNormalMapRec (CustomData)^ do begin
7612       Func(Vec, Position, HalfSize);
7613
7614       // Normalize
7615       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7616       if Len <> 0 then begin
7617         Vec[0] := Vec[0] * Len;
7618         Vec[1] := Vec[1] * Len;
7619         Vec[2] := Vec[2] * Len;
7620       end;
7621
7622       // Scale Vector and AddVectro
7623       Vec[0] := Vec[0] * 0.5 + 0.5;
7624       Vec[1] := Vec[1] * 0.5 + 0.5;
7625       Vec[2] := Vec[2] * 0.5 + 0.5;
7626     end;
7627
7628     // Set Color
7629     Dest.Red   := Round(Vec[0] * 255);
7630     Dest.Green := Round(Vec[1] * 255);
7631     Dest.Blue  := Round(Vec[2] * 255);
7632   end;
7633 end;
7634
7635
7636 procedure TglBitmapNormalMap.AfterConstruction;
7637 begin
7638   inherited;
7639
7640   fGenMode := GL_NORMAL_MAP;
7641 end;
7642
7643
7644 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
7645   TestTextureSize: Boolean);
7646 var
7647   Rec: TglBitmapNormalMapRec;
7648   SizeRec: TglBitmapPixelPosition;
7649 begin
7650   Rec.HalfSize := Size div 2;
7651
7652   FreeDataAfterGenTexture := false;
7653
7654   SizeRec.Fields := [ffX, ffY];
7655   SizeRec.X := Size;
7656   SizeRec.Y := Size;
7657
7658   // Positive X
7659   Rec.Func := glBitmapNormalMapPosX;
7660   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7661   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
7662
7663   // Negative X
7664   Rec.Func := glBitmapNormalMapNegX;
7665   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7666   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
7667
7668   // Positive Y
7669   Rec.Func := glBitmapNormalMapPosY;
7670   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7671   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
7672
7673   // Negative Y
7674   Rec.Func := glBitmapNormalMapNegY;
7675   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7676   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
7677
7678   // Positive Z
7679   Rec.Func := glBitmapNormalMapPosZ;
7680   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7681   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
7682
7683   // Negative Z
7684   Rec.Func := glBitmapNormalMapNegZ;
7685   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7686   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
7687 end;
7688 *)
7689
7690 initialization
7691   glBitmapSetDefaultFormat(tfEmpty);
7692   glBitmapSetDefaultMipmap(mmMipmap);
7693   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
7694   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
7695
7696   glBitmapSetDefaultFreeDataAfterGenTexture(true);
7697   glBitmapSetDefaultDeleteTextureOnFree    (true);
7698
7699   TFormatDescriptor.Init;
7700
7701 finalization
7702   TFormatDescriptor.Finalize;
7703
7704 end.