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   TglBitmapPixelDesc = packed record
 594     RedRange: Cardinal;
 595     RedShift: Shortint;
 596     GreenRange: Cardinal;
 597     GreenShift: Shortint;
 598     BlueRange: Cardinal;
 599     BlueShift: Shortint;
 600     AlphaRange: Cardinal;
 601     AlphaShift: Shortint;
 602   end;
 603
 604 ////////////////////////////////////////////////////////////////////////////////////////////////////
 605   TglBitmapPixelData = packed record
 606     Red: Cardinal;
 607     Green: Cardinal;
 608     Blue: Cardinal;
 609     Alpha: Cardinal;
 610     PixelDesc: TglBitmapPixelDesc;
 611   end;
 612
 613 ////////////////////////////////////////////////////////////////////////////////////////////////////
 614   TglBitmapFormatDesc = packed record
 615     Format: Cardinal;
 616     InternalFormat: Cardinal;
 617     DataType: Cardinal;
 618   end;
 619
 620 ////////////////////////////////////////////////////////////////////////////////////////////////////
 621   TglBitmapPixelPositionFields = set of (ffX, ffY);
 622   TglBitmapPixelPosition = record
 623     Fields : TglBitmapPixelPositionFields;
 624     X : Word;
 625     Y : Word;
 626   end;
 627
 628 ////////////////////////////////////////////////////////////////////////////////////////////////////
 629   TglBitmap = class;
 630   TglBitmapFunctionRec = record
 631     Sender : TglBitmap;
 632     Size: TglBitmapPixelPosition;
 633     Position: TglBitmapPixelPosition;
 634     Source: TglBitmapPixelData;
 635     Dest: TglBitmapPixelData;
 636     CustomData: Pointer;
 637   end;
 638   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 639
 640 ////////////////////////////////////////////////////////////////////////////////////////////////////
 641   TglBitmapFileType = (
 642       {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 643       {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 644       ftDDS,
 645       ftTGA,
 646       ftBMP);
 647   TglBitmapFileTypes = set of TglBitmapFileType;
 648
 649   TglBitmapMipMap = (
 650     mmNone,
 651     mmMipmap,
 652     mmMipmapGlu);
 653
 654   TglBitmapNormalMapFunc = (
 655     nm4Samples,
 656     nmSobel,
 657     nm3x3,
 658     nm5x5);
 659
 660   TglBitmapFormat = (
 661     tfEmpty = 0,
 662     { TODO
 663     tfAlpha4,
 664     tfAlpha8,
 665     tfAlpha12,
 666     tfAlpha16,
 667
 668     tfLuminance4, }
 669     tfLuminance8,
 670 {    tfLuminance12,
 671     tfLuminance16,
 672
 673     tfuminance4Alpha4,
 674     tfLuminance6Alpha2,}
 675     tfLuminance8Alpha8,
 676 {    tfLuminance12Alpha4,
 677     tfLuminance12Alpha12,
 678     tfLuminance16Alpha16,
 679
 680     tfR3G3B2,
 681     tfRGB4,
 682     tfRGB5, }
 683     tfRGB8,
 684 {    tfRGB10,
 685     tfRGB12,
 686     tfRGB16,
 687
 688     tfRGBA2,
 689     tfRGBA4,
 690     tfRGB5A1, }
 691     tfRGBA8,
 692 {    tfRGB10A2,
 693     tfRGBA12,
 694     tfRGBA16,
 695     }
 696     tfBGR8,
 697     tfBGRA8,
 698     {
 699     tfDepth16,
 700     tfDepth24,
 701     tfDepth32 }
 702   );
 703
 704 ////////////////////////////////////////////////////////////////////////////////////////////////////
 705   TglBitmapGetPixel  = procedure(const Pos: TglBitmapPixelPosition; var   Pixel: TglBitmapPixelData) of object;
 706   TglBitmapSetPixel  = procedure(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData) of object;
 707
 708   TglBitmapMapFunc   = procedure(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
 709   TglBitmapUnMapFunc = procedure(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData);
 710
 711 ////////////////////////////////////////////////////////////////////////////////////////////////////
 712   TglBitmapFormatDescriptor = class(TObject)
 713   public
 714     //virtual abstract
 715     class function GetFormat:     TglBitmapFormat;     virtual; abstract;
 716     class function GetPixelDesc:  TglBitmapPixelDesc;  virtual; abstract;
 717     class function GetFormatDesc: TglBitmapFormatDesc; virtual; abstract;
 718
 719     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte); virtual; abstract;
 720     class procedure Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData); virtual; abstract;
 721
 722     //virtual
 723     class function WithoutAlpha: TglBitmapFormat; virtual;
 724     class function WithAlpha:    TglBitmapFormat; virtual;
 725
 726     class function IsEmpty:  Boolean; virtual;
 727     class function HasAlpha: Boolean; virtual;
 728     class function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean; virtual;
 729
 730     class procedure PreparePixel(var aPixel: TglBitmapPixelData); virtual;
 731
 732     (* TODO
 733     function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
 734     function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
 735     function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
 736     function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
 737     function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
 738     *)
 739   end;
 740   TglBitmapFormatDescClass = class of TglBitmapFormatDescriptor;
 741
 742   // Base Class
 743   TglBitmap = class
 744   protected
 745     fID: Cardinal;
 746     fTarget: Cardinal;
 747     fAnisotropic: Integer;
 748     fDeleteTextureOnFree: Boolean;
 749     fFreeDataAfterGenTexture: Boolean;
 750     fData: PByte;
 751     fIsResident: Boolean;
 752     fBorderColor: array[0..3] of Single;
 753
 754     fDimension: TglBitmapPixelPosition;
 755     fMipMap: TglBitmapMipMap;
 756     fFormat: TglBitmapFormat;
 757
 758     // Mapping
 759     fPixelSize: Integer;
 760     fRowSize: Integer;
 761     fUnmapFunc: TglBitmapUnMapFunc;
 762     fMapFunc: TglBitmapMapFunc;
 763
 764     // Filtering
 765     fFilterMin: Cardinal;
 766     fFilterMag: Cardinal;
 767
 768     // TexturWarp
 769     fWrapS: Cardinal;
 770     fWrapT: Cardinal;
 771     fWrapR: Cardinal;
 772
 773     fGetPixelFunc: TglBitmapGetPixel;
 774     fSetPixelFunc: TglBitmapSetPixel;
 775
 776     // CustomData
 777     fFilename: String;
 778     fCustomName: String;
 779     fCustomNameW: WideString;
 780     fCustomData: Pointer;
 781
 782     //Getter
 783     function GetHeight: Integer; virtual;
 784     function GetWidth:  Integer; virtual;
 785
 786     //Setter
 787     procedure SetCustomData(const aValue: Pointer);
 788     procedure SetCustomName(const aValue: String);
 789     procedure SetCustomNameW(const aValue: WideString);
 790     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 791     procedure SetFormat(const aValue: TglBitmapFormat);
 792     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 793     procedure SetID(const aValue: Cardinal);
 794     procedure SetMipMap(const aValue: TglBitmapMipMap);
 795     procedure SetTarget(const aValue: Cardinal);
 796     procedure SetAnisotropic(const aValue: Integer);
 797
 798     //Load
 799     {$IFDEF GLB_SUPPORT_PNG_READ}
 800     function LoadPNG(Stream: TStream): Boolean; virtual;
 801     {$ENDIF}
 802     {$IFDEF GLB_SUPPORT_JPEG_READ}
 803     function LoadJPEG(Stream: TStream): Boolean; virtual;
 804     {$ENDIF}
 805     function LoadDDS(Stream: TStream): Boolean; virtual;
 806     function LoadTGA(Stream: TStream): Boolean; virtual;
 807     function LoadBMP(Stream: TStream): Boolean; virtual;
 808
 809     //Save
 810     {$IFDEF GLB_SUPPORT_PNG_WRITE}
 811     procedure SavePNG(Stream: TStream); virtual;
 812     {$ENDIF}
 813     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
 814     procedure SaveJPEG(Stream: TStream); virtual;
 815     {$ENDIF}
 816     procedure SaveDDS(Stream: TStream); virtual;
 817     procedure SaveTGA(Stream: TStream); virtual;
 818     procedure SaveBMP(Stream: TStream); virtual;
 819
 820     procedure CreateID;
 821     procedure SetupParameters(var aBuildWithGlu: Boolean);
 822     procedure SelectFormat(const aFormat: TglBitmapFormat; var glFormat, glInternalFormat, glType: Cardinal);
 823
 824     procedure SetDataPointer(NewData: pByte; Format: TglBitmapFormat; Width: Integer = -1; Height: Integer = -1); virtual;
 825     procedure GenTexture(TestTextureSize: Boolean = True); virtual; abstract;
 826
 827     function FlipHorz: Boolean; virtual;
 828     function FlipVert: Boolean; virtual;
 829
 830     property Width:  Integer read GetWidth;
 831     property Height: Integer read GetHeight;
 832   public
 833     property ID:           Cardinal        read fID          write SetID;
 834     property Target:       Cardinal        read fTarget      write SetTarget;
 835     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 836     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 837     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 838
 839     property Filename:    String     read fFilename;
 840     property CustomName:  String     read fCustomName  write SetCustomName;
 841     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
 842     property CustomData:  Pointer    read fCustomData  write SetCustomData;
 843
 844     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
 845     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
 846
 847     property Dimension:      TglBitmapPixelPosition  read fDimension;
 848     property Data:           PByte                   read fData;
 849     property IsResident:     Boolean                 read fIsResident;
 850
 851     procedure AfterConstruction; override;
 852     procedure BeforeDestruction; override;
 853
 854     //Loading
 855     procedure LoadFromFile(const aFileName: String);
 856     procedure LoadFromStream(const aStream: TStream); virtual;
 857     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
 858       const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0);
 859     {$IFDEF GLB_DELPHI}
 860     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; const aResType: PChar = nil);
 861     procedure LoadFromResourceID(const sInstance: Cardinal; aResourceID: Integer; const aResType: PChar);
 862     {$ENDIF}
 863
 864     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
 865     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 866
 867     //function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; Format: TglBitmapFormat; CustomData: Pointer = nil): boolean; overload;
 868     //function AddFunc(const aFunc: TglBitmapFunction; CreateTemp: Boolean; CustomData: Pointer = nil): boolean; overload;
 869 (* TODO
 870     {$IFDEF GLB_SDL}
 871     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 872     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 873     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 874     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
 875       const aArgs: PtrInt = 0): Boolean;
 876     {$ENDIF}
 877
 878     {$IFDEF GLB_DELPHI}
 879     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 880     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 881     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 882     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
 883       const aArgs: PtrInt = 0): Boolean;
 884     {$ENDIF}
 885
 886     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0): Boolean; virtual;
 887     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 888     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 889     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 890     {$IFDEF GLB_DELPHI}
 891     function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
 892       const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 893     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
 894       const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 895     {$ENDIF}
 896
 897     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 898     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 899     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 900
 901     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 902     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 903     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 904
 905     function RemoveAlpha: Boolean; virtual;
 906     function Clone: TglBitmap;
 907     function ConvertTo(const aFormat: TglBitmapFormat; const aInternalFormat: TglBitmapFormat): Boolean; virtual;
 908     procedure SetBorderColor(Red, Green, Blue, Alpha: Single);
 909     procedure Invert(const aUseRGB: Boolean = true; aUseAlpha: Boolean = false);
 910     procedure FreeData;
 911
 912     procedure FillWithColor(const aRed, aGreen, aBlue: aByte; Alpha: Byte = 255);
 913     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 914     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
 915 *)
 916     procedure SetFilter(const aMin, aMag: Cardinal);
 917     procedure SetWrap(
 918       const S: Cardinal = GL_CLAMP_TO_EDGE;
 919       const T: Cardinal = GL_CLAMP_TO_EDGE;
 920       const R: Cardinal = GL_CLAMP_TO_EDGE);
 921
 922     procedure GetPixel(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);   virtual;
 923     procedure SetPixel(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData); virtual;
 924
 925     procedure Unbind(DisableTextureUnit: Boolean = True); virtual;
 926     procedure Bind(EnableTextureUnit: Boolean = True); virtual;
 927
 928     constructor Create; overload;
 929     constructor Create(FileName: String); overload;
 930     constructor Create(Stream: TStream); overload;
 931     {$IFDEF GLB_DELPHI}
 932     constructor CreateFromResourceName(Instance: Cardinal; Resource: String; ResType: PChar = nil);
 933     constructor Create(Instance: Cardinal; Resource: String; ResType: PChar = nil); overload;
 934     constructor Create(Instance: Cardinal; ResourceID: Integer; ResType: PChar); overload;
 935     {$ENDIF}
 936     constructor Create(Size: TglBitmapPixelPosition; Format: TglBitmapFormat); overload;
 937     constructor Create(Size: TglBitmapPixelPosition; Format: TglBitmapFormat; Func: TglBitmapFunction; CustomData: Pointer = nil); overload;
 938   end;
 939
 940
 941   TglBitmap2D = class(TglBitmap)
 942   protected
 943     // Bildeinstellungen
 944     fLines: array of PByte;
 945
 946     procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
 947     procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 948     procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 949     procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 950     procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 951     function GetScanline(Index: Integer): Pointer;
 952
 953     procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
 954
 955     procedure SetDataPointer(Data: pByte; Format: TglBitmapFormat; Width: Integer = -1; Height: Integer = -1); override;
 956     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
 957   public
 958     property Width;
 959     property Height;
 960     property Scanline[Index: Integer]: Pointer read GetScanline;
 961
 962     procedure AfterConstruction; override;
 963
 964     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
 965     procedure GetDataFromTexture;
 966     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3; const aScale: Single = 2; const aUseAlpha: Boolean = False);
 967     procedure GenTexture(TestTextureSize: Boolean = True); override;
 968
 969     function FlipHorz: Boolean; override;
 970     function FlipVert: Boolean; override;
 971   end;
 972
 973 (* TODO
 974   TglBitmapCubeMap = class(TglBitmap2D)
 975   protected
 976     fGenMode: Integer;
 977
 978     // Hide GenTexture
 979     procedure GenTexture(TestTextureSize: Boolean = True); reintroduce;
 980   public
 981     procedure AfterConstruction; override;
 982
 983     procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
 984
 985     procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = True); reintroduce; virtual;
 986     procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = True); reintroduce; virtual;
 987   end;
 988
 989
 990   TglBitmapNormalMap = class(TglBitmapCubeMap)
 991   public
 992     procedure AfterConstruction; override;
 993
 994     procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
 995   end;
 996
 997
 998   TglBitmap1D = class(TglBitmap)
 999   protected
1000     procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1001
1002     procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
1003     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
1004   public
1005     // propertys
1006     property Width;
1007
1008     procedure AfterConstruction; override;
1009
1010     // Other
1011     function FlipHorz: Boolean; override;
1012
1013     // Generation
1014     procedure GenTexture(TestTextureSize: Boolean = True); override;
1015   end;
1016 *)
1017
1018 const
1019   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1020
1021 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1022 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1023 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1024 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1025 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1026 procedure glBitmapSetDefaultWrap(
1027   const S: Cardinal = GL_CLAMP_TO_EDGE;
1028   const T: Cardinal = GL_CLAMP_TO_EDGE;
1029   const R: Cardinal = GL_CLAMP_TO_EDGE);
1030
1031 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1032 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1033 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1034 function glBitmapGetDefaultFormat: TglBitmapFormat;
1035 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1036 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1037
1038 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1039
1040 // Formatfunctions
1041 function FormatGetSize(const aFormat: TglBitmapFormat): Single;
1042
1043 var
1044   glBitmapDefaultDeleteTextureOnFree: Boolean;
1045   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1046   glBitmapDefaultFormat: TglBitmapFormat;
1047   glBitmapDefaultMipmap: TglBitmapMipMap;
1048   glBitmapDefaultFilterMin: Cardinal;
1049   glBitmapDefaultFilterMag: Cardinal;
1050   glBitmapDefaultWrapS: Cardinal;
1051   glBitmapDefaultWrapT: Cardinal;
1052   glBitmapDefaultWrapR: Cardinal;
1053
1054 {$IFDEF GLB_DELPHI}
1055 function CreateGrayPalette: HPALETTE;
1056 {$ENDIF}
1057
1058 implementation
1059
1060 uses
1061   Math;
1062
1063 type
1064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1065   TfdEmpty = class(TglBitmapFormatDescriptor)
1066   public
1067     class function GetFormat: TglBitmapFormat; override;
1068     class function GetPixelDesc: TglBitmapPixelDesc; override;
1069     class function GetFormatDesc: TglBitmapFormatDesc; override;
1070
1071     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte); override;
1072     class procedure Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData); override;
1073   end;
1074
1075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1076   TfdLuminance8 = class(TglBitmapFormatDescriptor)
1077   public
1078     class function GetFormat: TglBitmapFormat; override;
1079     class function GetPixelDesc: TglBitmapPixelDesc; override;
1080     class function GetFormatDesc: TglBitmapFormatDesc; override;
1081     class function WithAlpha: TglBitmapFormat; override;
1082
1083     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte); override;
1084     class procedure Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData); override;
1085   end;
1086
1087 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1088   TfdLuminance8Alpha8 = class(TglBitmapFormatDescriptor)
1089     public
1090       class function GetFormat: TglBitmapFormat; override;
1091       class function GetPixelDesc: TglBitmapPixelDesc; override;
1092       class function GetFormatDesc: TglBitmapFormatDesc; override;
1093       class function WithoutAlpha: TglBitmapFormat; override;
1094
1095       class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte); override;
1096       class procedure Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData); override;
1097     end;
1098
1099 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1100   TfdRGB8 = class(TglBitmapFormatDescriptor)
1101   public
1102     class function GetFormat: TglBitmapFormat; override;
1103     class function GetPixelDesc: TglBitmapPixelDesc; override;
1104     class function GetFormatDesc: TglBitmapFormatDesc; override;
1105     class function WithAlpha: TglBitmapFormat; override;
1106
1107     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte); override;
1108     class procedure Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData); override;
1109   end;
1110
1111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1112   TfdRGBA8 = class(TglBitmapFormatDescriptor)
1113   public
1114     class function GetFormat: TglBitmapFormat; override;
1115     class function GetPixelDesc: TglBitmapPixelDesc; override;
1116     class function GetFormatDesc: TglBitmapFormatDesc; override;
1117     class function WithoutAlpha: TglBitmapFormat; override;
1118
1119     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte); override;
1120     class procedure Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData); override;
1121   end;
1122
1123 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1124   TfdBGR8 = class(TglBitmapFormatDescriptor)
1125   public
1126     class function GetFormat: TglBitmapFormat; override;
1127     class function GetPixelDesc: TglBitmapPixelDesc; override;
1128     class function GetFormatDesc: TglBitmapFormatDesc; override;
1129     class function WithAlpha: TglBitmapFormat; override;
1130
1131     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte); override;
1132     class procedure Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData); override;
1133   end;
1134
1135 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1136   TfdBGRA8 = class(TglBitmapFormatDescriptor)
1137   public
1138     class function GetFormat: TglBitmapFormat; override;
1139     class function GetPixelDesc: TglBitmapPixelDesc; override;
1140     class function GetFormatDesc: TglBitmapFormatDesc; override;
1141     class function WithoutAlpha: TglBitmapFormat; override;
1142
1143     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte); override;
1144     class procedure Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData); override;
1145   end;
1146
1147 const
1148   LUMINANCE_WEIGHT_R = 0.30;
1149   LUMINANCE_WEIGHT_G = 0.59;
1150   LUMINANCE_WEIGHT_B = 0.11;
1151   UNSUPPORTED_INTERNAL_FORMAT = 'the given format isn''t supported by this function.';
1152
1153 {$REGION Private Helper}
1154 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1155 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1156 begin
1157   Result.Fields := [];
1158
1159   if X >= 0 then
1160     Result.Fields := Result.Fields + [ffX];
1161   if Y >= 0 then
1162     Result.Fields := Result.Fields + [ffY];
1163
1164   Result.X := Max(0, X);
1165   Result.Y := Max(0, Y);
1166 end;
1167
1168 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1169 function FormatGetImageSize(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat): Integer;
1170 begin
1171   if (aSize.X = 0) and (aSize.Y = 0) then
1172     Result := 0
1173   else
1174     Result := Ceil(Max(aSize.Y, 1) * Max(aSize.X, 1) * FormatGetSize(aFormat));
1175 end;
1176
1177 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1178 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1179 begin
1180   //TODO check Formats!
1181   result := [];
1182
1183   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1184   if aFormat in [
1185     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1186     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1187     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1188     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1189     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1190     tfDepth16, tfDepth24, tfDepth32]
1191   then
1192     result := result + [ftPNG];
1193   {$ENDIF}
1194
1195   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1196   if Format in [
1197     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1198     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1199     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1200     tfDepth16, tfDepth24, tfDepth32]
1201   then
1202     result := result + [ftJPEG];
1203   {$ENDIF}
1204
1205   if aFormat in [
1206     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1207     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1208     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1209     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1210     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1211     tfDepth16, tfDepth24, tfDepth32]
1212   then
1213     result := result + [ftDDS, ftTGA, ftBMP];
1214 end;
1215
1216 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1217 function IsPowerOfTwo(aNumber: Integer): Boolean;
1218 begin
1219   while (aNumber and 1) = 0 do
1220     aNumber := aNumber shr 1;
1221   result := aNumber = 1;
1222 end;
1223
1224 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1225 function GetBitSize(aBitSet: Cardinal): Integer;
1226 begin
1227   result := 0;
1228   while aBitSet > 0 do begin
1229     if (aBitSet and 1) = 1 then
1230       inc(result);
1231     aBitSet := aBitSet shr 1;
1232   end;
1233 end;
1234 {$ENDREGION}
1235
1236 (* GLB_NO_NATIVE_GL
1237 {$IFNDEF GLB_NO_NATIVE_GL}
1238 procedure ReadOpenGLExtensions;
1239 var
1240   {$IFDEF GLB_DELPHI}
1241   Context: HGLRC;
1242   {$ENDIF}
1243   Buffer: AnsiString;
1244   MajorVersion, MinorVersion: Integer;
1245
1246
1247   procedure TrimVersionString(Buffer: AnsiString; var Major, Minor: Integer);
1248   var
1249     Separator: Integer;
1250   begin
1251     Minor := 0;
1252     Major := 0;
1253
1254     Separator := Pos(AnsiString('.'), Buffer);
1255
1256     if (Separator > 1) and (Separator < Length(Buffer)) and
1257        (Buffer[Separator - 1] in ['0'..'9']) and
1258        (Buffer[Separator + 1] in ['0'..'9']) then begin
1259
1260       Dec(Separator);
1261       while (Separator > 0) and (Buffer[Separator] in ['0'..'9']) do
1262         Dec(Separator);
1263
1264       Delete(Buffer, 1, Separator);
1265       Separator := Pos(AnsiString('.'), Buffer) + 1;
1266
1267       while (Separator <= Length(Buffer)) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do
1268         Inc(Separator);
1269
1270       Delete(Buffer, Separator, 255);
1271       Separator := Pos(AnsiString('.'), Buffer);
1272
1273       Major := StrToInt(Copy(String(Buffer), 1, Separator - 1));
1274       Minor := StrToInt(Copy(String(Buffer), Separator + 1, 1));
1275     end;
1276   end;
1277
1278
1279   function CheckExtension(const Extension: AnsiString): Boolean;
1280   var
1281     ExtPos: Integer;
1282   begin
1283     ExtPos := Pos(Extension, Buffer);
1284     Result := ExtPos > 0;
1285
1286     if Result then
1287       Result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
1288   end;
1289
1290
1291   function glLoad (aFunc: pAnsiChar): pointer;
1292   begin
1293     {$IFDEF LINUX}
1294       Result := glXGetProcAddress(aFunc);
1295     {$else}
1296       Result := wglGetProcAddress(aFunc);
1297     {$ENDIF}
1298   end;
1299
1300
1301 begin
1302   {$IFDEF GLB_DELPHI}
1303   Context := wglGetCurrentContext;
1304
1305   if Context <> gLastContext then begin
1306     gLastContext := Context;
1307   {$ENDIF}
1308
1309     // Version
1310     Buffer := glGetString(GL_VERSION);
1311     TrimVersionString(Buffer, MajorVersion, MinorVersion);
1312
1313     GL_VERSION_1_2 := False;
1314     GL_VERSION_1_3 := False;
1315     GL_VERSION_1_4 := False;
1316     GL_VERSION_2_0 := False;
1317
1318     if MajorVersion = 1 then begin
1319       if MinorVersion >= 1 then begin
1320         if MinorVersion >= 2 then
1321           GL_VERSION_1_2 := True;
1322
1323         if MinorVersion >= 3 then
1324           GL_VERSION_1_3 := True;
1325
1326         if MinorVersion >= 4 then
1327           GL_VERSION_1_4 := True;
1328       end;
1329     end;
1330
1331     if MajorVersion >= 2 then begin
1332       GL_VERSION_1_2 := True;
1333       GL_VERSION_1_3 := True;
1334       GL_VERSION_1_4 := True;
1335       GL_VERSION_2_0 := True;
1336     end;
1337
1338     // Extensions
1339     Buffer := glGetString(GL_EXTENSIONS);
1340     GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
1341     GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
1342     GL_ARB_texture_compression        := CheckExtension('GL_ARB_texture_compression');
1343     GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
1344     GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
1345     GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
1346     GL_EXT_bgra                       := CheckExtension('GL_EXT_bgra');
1347     GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
1348     GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
1349     GL_EXT_texture_compression_s3tc   := CheckExtension('GL_EXT_texture_compression_s3tc');
1350     GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
1351     GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
1352     GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
1353     GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
1354     GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
1355
1356     // Funtions
1357     if GL_VERSION_1_3 then begin
1358       // Loading Core
1359       glCompressedTexImage1D := glLoad('glCompressedTexImage1D');
1360       glCompressedTexImage2D := glLoad('glCompressedTexImage2D');
1361       glGetCompressedTexImage := glLoad('glGetCompressedTexImage');
1362     end else
1363
1364     begin
1365       // Try loading Extension
1366       glCompressedTexImage1D := glLoad('glCompressedTexImage1DARB');
1367       glCompressedTexImage2D := glLoad('glCompressedTexImage2DARB');
1368       glGetCompressedTexImage := glLoad('glGetCompressedTexImageARB');
1369     end;
1370   {$IFDEF GLB_DELPHI}
1371   end;
1372   {$ENDIF}
1373 end;
1374 {$ENDIF}
1375 *)
1376
1377 (* TODO GLB_DELPHI
1378 {$IFDEF GLB_DELPHI}
1379 function CreateGrayPalette: HPALETTE;
1380 var
1381   Idx: Integer;
1382   Pal: PLogPalette;
1383 begin
1384   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
1385
1386   Pal.palVersion := $300;
1387   Pal.palNumEntries := 256;
1388
1389   {$IFOPT R+}
1390     {$DEFINE GLB_TEMPRANGECHECK}
1391     {$R-}
1392   {$ENDIF}
1393
1394   for Idx := 0 to 256 - 1 do begin
1395     Pal.palPalEntry[Idx].peRed   := Idx;
1396     Pal.palPalEntry[Idx].peGreen := Idx;
1397     Pal.palPalEntry[Idx].peBlue  := Idx;
1398     Pal.palPalEntry[Idx].peFlags := 0;
1399   end;
1400
1401   {$IFDEF GLB_TEMPRANGECHECK}
1402     {$UNDEF GLB_TEMPRANGECHECK}
1403     {$R+}
1404   {$ENDIF}
1405
1406   Result := CreatePalette(Pal^);
1407
1408   FreeMem(Pal);
1409 end;
1410 {$ENDIF}
1411 *)
1412
1413 (* TODO GLB_SDL_IMAGE
1414 {$IFDEF GLB_SDL_IMAGE}
1415 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
1416 begin
1417   Result := TStream(context^.unknown.data1).Seek(offset, whence);
1418 end;
1419
1420 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
1421 begin
1422   Result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
1423 end;
1424
1425 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
1426 begin
1427   Result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
1428 end;
1429
1430 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
1431 begin
1432   Result := 0;
1433 end;
1434
1435 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
1436 begin
1437   Result := SDL_AllocRW;
1438
1439   if Result = nil then
1440     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
1441
1442   Result^.seek := glBitmapRWseek;
1443   Result^.read := glBitmapRWread;
1444   Result^.write := glBitmapRWwrite;
1445   Result^.close := glBitmapRWclose;
1446   Result^.unknown.data1 := Stream;
1447 end;
1448 {$ENDIF}
1449 *)
1450
1451 (* TODO LoadFuncs
1452 function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
1453 var
1454   glBitmap: TglBitmap2D;
1455 begin
1456   Result := false;
1457   Texture := 0;
1458
1459   {$IFDEF GLB_DELPHI}
1460   if Instance = 0 then
1461     Instance := HInstance;
1462
1463   if (LoadFromRes) then
1464     glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
1465   else
1466   {$ENDIF}
1467     glBitmap := TglBitmap2D.Create(FileName);
1468
1469   try
1470     glBitmap.DeleteTextureOnFree := False;
1471     glBitmap.FreeDataAfterGenTexture := False;
1472     glBitmap.GenTexture(True);
1473     if (glBitmap.ID > 0) then begin
1474       Texture := glBitmap.ID;
1475       Result := True;
1476     end;
1477   finally
1478     glBitmap.Free;
1479   end;
1480 end;
1481
1482 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
1483 var
1484   CM: TglBitmapCubeMap;
1485 begin
1486   Texture := 0;
1487
1488   {$IFDEF GLB_DELPHI}
1489   if Instance = 0 then
1490     Instance := HInstance;
1491   {$ENDIF}
1492
1493   CM := TglBitmapCubeMap.Create;
1494   try
1495     CM.DeleteTextureOnFree := False;
1496
1497     // Maps
1498     {$IFDEF GLB_DELPHI}
1499     if (LoadFromRes) then
1500       CM.LoadFromResource(Instance, PositiveX)
1501     else
1502     {$ENDIF}
1503       CM.LoadFromFile(PositiveX);
1504     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
1505
1506     {$IFDEF GLB_DELPHI}
1507     if (LoadFromRes) then
1508       CM.LoadFromResource(Instance, NegativeX)
1509     else
1510     {$ENDIF}
1511       CM.LoadFromFile(NegativeX);
1512     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
1513
1514     {$IFDEF GLB_DELPHI}
1515     if (LoadFromRes) then
1516       CM.LoadFromResource(Instance, PositiveY)
1517     else
1518     {$ENDIF}
1519       CM.LoadFromFile(PositiveY);
1520     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
1521
1522     {$IFDEF GLB_DELPHI}
1523     if (LoadFromRes) then
1524       CM.LoadFromResource(Instance, NegativeY)
1525     else
1526     {$ENDIF}
1527       CM.LoadFromFile(NegativeY);
1528     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
1529
1530     {$IFDEF GLB_DELPHI}
1531     if (LoadFromRes) then
1532       CM.LoadFromResource(Instance, PositiveZ)
1533     else
1534     {$ENDIF}
1535       CM.LoadFromFile(PositiveZ);
1536     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
1537
1538     {$IFDEF GLB_DELPHI}
1539     if (LoadFromRes) then
1540       CM.LoadFromResource(Instance, NegativeZ)
1541     else
1542     {$ENDIF}
1543       CM.LoadFromFile(NegativeZ);
1544     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
1545
1546     Texture := CM.ID;
1547     Result := True;
1548   finally
1549     CM.Free;
1550   end;
1551 end;
1552
1553 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
1554 var
1555   NM: TglBitmapNormalMap;
1556 begin
1557   Texture := 0;
1558
1559   NM := TglBitmapNormalMap.Create;
1560   try
1561     NM.DeleteTextureOnFree := False;
1562     NM.GenerateNormalMap(Size);
1563
1564     Texture := NM.ID;
1565     Result := True;
1566   finally
1567     NM.Free;
1568   end;
1569 end;
1570 *)
1571
1572 {$REGION default Setter and Gettter}
1573 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1574 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1575 begin
1576   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
1577 end;
1578
1579 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1580 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1581 begin
1582   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
1583 end;
1584
1585 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1586 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1587 begin
1588   glBitmapDefaultMipmap := aValue;
1589 end;
1590
1591 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1592 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1593 begin
1594   glBitmapDefaultFormat := aFormat;
1595 end;
1596
1597 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1598 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1599 begin
1600   glBitmapDefaultFilterMin := aMin;
1601   glBitmapDefaultFilterMag := aMag;
1602 end;
1603
1604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1605 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
1606 begin
1607   glBitmapDefaultWrapS := S;
1608   glBitmapDefaultWrapT := T;
1609   glBitmapDefaultWrapR := R;
1610 end;
1611
1612 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1613 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1614 begin
1615   result := glBitmapDefaultDeleteTextureOnFree;
1616 end;
1617
1618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1619 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1620 begin
1621   result := glBitmapDefaultFreeDataAfterGenTextures;
1622 end;
1623
1624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1625 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1626 begin
1627   result := glBitmapDefaultMipmap;
1628 end;
1629
1630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1631 function glBitmapGetDefaultFormat: TglBitmapFormat;
1632 begin
1633   result := glBitmapDefaultFormat;
1634 end;
1635
1636 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1637 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1638 begin
1639   aMin := glBitmapDefaultFilterMin;
1640   aMag := glBitmapDefaultFilterMag;
1641 end;
1642
1643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1644 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1645 begin
1646   S := glBitmapDefaultWrapS;
1647   T := glBitmapDefaultWrapT;
1648   R := glBitmapDefaultWrapR;
1649 end;
1650 {$ENDREGION}
1651
1652 {$REGION TglBitmapFormatDescriptor}
1653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1654 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1655 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1656 class function TglBitmapFormatDescriptor.WithoutAlpha: TglBitmapFormat;
1657 begin
1658   if not HasAlpha then
1659     result := GetFormat
1660   else
1661     result := tfEmpty;
1662 end;
1663
1664 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1665 class function TglBitmapFormatDescriptor.WithAlpha: TglBitmapFormat;
1666 begin
1667   if HasAlpha then
1668     result := GetFormat
1669   else
1670     result := tfEmpty;
1671 end;
1672
1673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1674 class function TglBitmapFormatDescriptor.IsEmpty: Boolean;
1675 begin
1676   result := (GetFormat = tfEmpty);
1677 end;
1678
1679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1680 class function TglBitmapFormatDescriptor.HasAlpha: Boolean;
1681 begin
1682   result := (GetPixelDesc.AlphaRange > 0);
1683 end;
1684
1685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1686 class function TglBitmapFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean;
1687 var
1688   PixelDesc: TglBitmapPixelDesc;
1689 begin
1690   result := False;
1691
1692   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
1693     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
1694
1695   PixelDesc := GetPixelDesc;
1696   with PixelDesc do begin
1697     if (aRedMask   <> 0) and (aRedMask   <> (RedRange   shl RedShift)) then
1698       exit;
1699     if (aGreenMask <> 0) and (aGreenMask <> (GreenRange shl GreenShift)) then
1700       exit;
1701     if (aBlueMask  <> 0) and (aBlueMask  <> (BlueRange  shl BlueShift)) then
1702       exit;
1703     if (aAlphaMask <> 0) and (aAlphaMask <> (AlphaRange shl AlphaShift)) then
1704       exit;
1705   end;
1706   result := True;
1707 end;
1708
1709 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1710 class procedure TglBitmapFormatDescriptor.PreparePixel(var aPixel: TglBitmapPixelData);
1711 begin
1712   FillChar(aPixel, SizeOf(aPixel), 0);
1713   with GetPixelDesc do begin
1714     aPixel.Red   := RedRange;
1715     aPixel.Green := GreenRange;
1716     aPixel.Blue  := BlueRange;
1717     aPixel.Alpha := AlphaRange;
1718   end;
1719 end;
1720 {$ENDREGION}
1721
1722 {$REGION TfdEmpty}
1723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1724 //TfdEmpty////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1726 class function TfdEmpty.GetFormat: TglBitmapFormat;
1727 begin
1728   result := tfEmpty;
1729 end;
1730
1731 class function TfdEmpty.GetPixelDesc: TglBitmapPixelDesc;
1732 begin
1733   with result do begin
1734     RedRange   := $00000000; RedShift   := 0;
1735     GreenRange := $00000000; GreenShift := 0;
1736     BlueRange  := $00000000; BlueShift  := 0;
1737     AlphaRange := $00000000; AlphaShift := 0;
1738   end;
1739 end;
1740
1741 class function TfdEmpty.GetFormatDesc: TglBitmapFormatDesc;
1742 begin
1743   with result do begin
1744     Format         := 0;
1745     InternalFormat := 0;
1746     DataType       := 0;
1747   end;
1748 end;
1749
1750 class procedure TfdEmpty.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1751 begin
1752   raise EglBitmapException.Create('format does not support mapping');
1753 end;
1754
1755 class procedure TfdEmpty.Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData);
1756 begin
1757   raise EglBitmapException.Create('format does not support unmapping');
1758 end;
1759 {$ENDREGION}
1760
1761 {$REGION TfdLuminance8}
1762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1763 //TfdLuminance8///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1765 class function TfdLuminance8.GetFormat: TglBitmapFormat;
1766 begin
1767   result := tfEmpty;
1768 end;
1769
1770 class function TfdLuminance8.GetPixelDesc: TglBitmapPixelDesc;
1771 begin
1772   with result do begin
1773     RedRange   := $000000FF; RedShift   := 0;
1774     GreenRange := $000000FF; GreenShift := 0;
1775     BlueRange  := $000000FF; BlueShift  := 0;
1776     AlphaRange := $00000000; AlphaShift := 0;
1777   end;
1778 end;
1779
1780 class function TfdLuminance8.GetFormatDesc: TglBitmapFormatDesc;
1781 begin
1782   with result do begin
1783     Format         := GL_LUMINANCE;
1784     InternalFormat := GL_LUMINANCE8;
1785     DataType       := GL_UNSIGNED_BYTE;
1786   end;
1787 end;
1788
1789 class function TfdLuminance8.WithAlpha: TglBitmapFormat;
1790 begin
1791   result := tfLuminance8Alpha8;
1792 end;
1793
1794 class procedure TfdLuminance8.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1795 begin
1796   aData^ := Trunc(
1797     aPixel.Red   * LUMINANCE_WEIGHT_R +
1798     aPixel.Green * LUMINANCE_WEIGHT_G +
1799     aPixel.Blue  * LUMINANCE_WEIGHT_B);
1800   inc(aData);
1801 end;
1802
1803 class procedure TfdLuminance8.Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData);
1804 begin
1805   aPixel.Red   := aData^;
1806   aPixel.Green := aData^;
1807   aPixel.Blue  := aData^;
1808   aPixel.Alpha := 0;
1809   inc(aData);
1810 end;
1811 {$ENDREGION}
1812
1813 {$REGION TfdLuminance8Alpha8}
1814 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1815 //TfdLuminance8Alpha8/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1817 class function TfdLuminance8Alpha8.GetFormat: TglBitmapFormat;
1818 begin
1819   result := tfLuminance8Alpha8;
1820 end;
1821
1822 class function TfdLuminance8Alpha8.GetPixelDesc: TglBitmapPixelDesc;
1823 begin
1824   with result do begin
1825     RedRange   := $000000FF; RedShift   := 0;
1826     GreenRange := $000000FF; GreenShift := 0;
1827     BlueRange  := $000000FF; BlueShift  := 0;
1828     AlphaRange := $000000FF; AlphaShift := 8;
1829   end;
1830 end;
1831
1832 class function TfdLuminance8Alpha8.GetFormatDesc: TglBitmapFormatDesc;
1833 begin
1834   with result do begin
1835     Format         := GL_LUMINANCE_ALPHA;
1836     InternalFormat := GL_LUMINANCE8_ALPHA8;
1837     DataType       := GL_UNSIGNED_BYTE;
1838   end;
1839 end;
1840
1841 class function TfdLuminance8Alpha8.WithoutAlpha: TglBitmapFormat;
1842 begin
1843   result := tfLuminance8;
1844 end;
1845
1846 class procedure TfdLuminance8Alpha8.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1847 begin
1848   aData^ := Trunc(
1849     aPixel.Red   * LUMINANCE_WEIGHT_R +
1850     aPixel.Green * LUMINANCE_WEIGHT_G +
1851     aPixel.Blue  * LUMINANCE_WEIGHT_B);
1852   inc(aData);
1853
1854   aData^ := aPixel.Alpha;
1855   inc(aData);
1856 end;
1857
1858 class procedure TfdLuminance8Alpha8.Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData);
1859 begin
1860   aPixel.Red   := aData^;
1861   aPixel.Green := aData^;
1862   aPixel.Blue  := aData^;
1863   inc(aData);
1864
1865   aPixel.Alpha := aData^;
1866   inc(aData);
1867 end;
1868 {$ENDREGION}
1869
1870 {$REGION TfdRGB8}
1871 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1872 //TfdRGB8/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1873 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1874 class function TfdRGB8.GetFormat: TglBitmapFormat;
1875 begin
1876   result := tfRGB8;
1877 end;
1878
1879 class function TfdRGB8.GetPixelDesc: TglBitmapPixelDesc;
1880 begin
1881   with result do begin
1882     RedRange   := $000000FF; RedShift   := 0;
1883     GreenRange := $000000FF; GreenShift := 8;
1884     BlueRange  := $000000FF; BlueShift  := 16;
1885     AlphaRange := $00000000; AlphaShift := 0;
1886   end;
1887 end;
1888
1889 class function TfdRGB8.GetFormatDesc: TglBitmapFormatDesc;
1890 begin
1891   with result do begin
1892     Format         := GL_LUMINANCE;
1893     InternalFormat := GL_LUMINANCE8;
1894     DataType       := GL_UNSIGNED_BYTE;
1895   end;
1896 end;
1897
1898 class function TfdRGB8.WithAlpha: TglBitmapFormat;
1899 begin
1900   result := tfRGBA8;
1901 end;
1902
1903 class procedure TfdRGB8.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1904 begin
1905   aData^ := aPixel.Red;
1906   inc(aData);
1907   aData^ := aPixel.Green;
1908   inc(aData);
1909   aData^ := aPixel.Blue;
1910   inc(aData);
1911 end;
1912
1913 class procedure TfdRGB8.Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData);
1914 begin
1915   aPixel.Red := aData^;
1916   inc(aData);
1917   aPixel.Green := aData^;
1918   inc(aData);
1919   aPixel.Blue := aData^;
1920   inc(aData);
1921   aPixel.Alpha := 0;
1922 end;
1923 {$ENDREGION}
1924
1925 {$REGION TfdRGBA8}
1926 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1927 //TfdRGBA8////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1928 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1929 class function TfdRGBA8.GetFormat: TglBitmapFormat;
1930 begin
1931   result := tfRGBA8;
1932 end;
1933
1934 class function TfdRGBA8.GetPixelDesc: TglBitmapPixelDesc;
1935 begin
1936   with result do begin
1937     RedRange   := $000000FF; RedShift   := 0;
1938     GreenRange := $000000FF; GreenShift := 8;
1939     BlueRange  := $000000FF; BlueShift  := 16;
1940     AlphaRange := $000000FF; AlphaShift := 24;
1941   end;
1942 end;
1943
1944 class function TfdRGBA8.GetFormatDesc: TglBitmapFormatDesc;
1945 begin
1946   with result do begin
1947     Format         := GL_RGB;
1948     InternalFormat := GL_RGB8;
1949     DataType       := GL_UNSIGNED_BYTE;
1950   end;
1951 end;
1952
1953 class function TfdRGBA8.WithoutAlpha: TglBitmapFormat;
1954 begin
1955   result := tfRGB8;
1956 end;
1957
1958 class procedure TfdRGBA8.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1959 begin
1960   aData^ := aPixel.Red;
1961   inc(aData);
1962   aData^ := aPixel.Green;
1963   inc(aData);
1964   aData^ := aPixel.Blue;
1965   inc(aData);
1966   aData^ := aPixel.Alpha;
1967   inc(aData);
1968 end;
1969
1970 class procedure TfdRGBA8.Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData);
1971 begin
1972   aPixel.Red := aData^;
1973   inc(aData);
1974   aPixel.Green := aData^;
1975   inc(aData);
1976   aPixel.Blue := aData^;
1977   inc(aData);
1978   aPixel.Alpha := aData^;
1979   inc(aData);
1980 end;
1981 {$ENDREGION}
1982
1983 {$REGION TfdBGR8}
1984 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1985 //TfdBGR8/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1986 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1987 class function TfdBGR8.GetFormat: TglBitmapFormat;
1988 begin
1989   result := tfBGR8;
1990 end;
1991
1992 class function TfdBGR8.GetPixelDesc: TglBitmapPixelDesc;
1993 begin
1994   with result do begin
1995     RedRange   := $000000FF; RedShift   := 16;
1996     GreenRange := $000000FF; GreenShift := 8;
1997     BlueRange  := $000000FF; BlueShift  := 0;
1998     AlphaRange := $00000000; AlphaShift := 0;
1999   end;
2000 end;
2001
2002 class function TfdBGR8.GetFormatDesc: TglBitmapFormatDesc;
2003 begin
2004   with result do begin
2005     Format         := GL_BGR;
2006     InternalFormat := GL_RGB8;
2007     DataType       := GL_UNSIGNED_BYTE;
2008   end;
2009 end;
2010
2011 class function TfdBGR8.WithAlpha: TglBitmapFormat;
2012 begin
2013   result := tfBGRA8;
2014 end;
2015
2016 class procedure TfdBGR8.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
2017 begin
2018   aData^ := aPixel.Blue;
2019   inc(aData);
2020   aData^ := aPixel.Green;
2021   inc(aData);
2022   aData^ := aPixel.Red;
2023   inc(aData);
2024 end;
2025
2026 class procedure TfdBGR8.Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData);
2027 begin
2028   aPixel.Blue := aData^;
2029   inc(aData);
2030   aPixel.Green := aData^;
2031   inc(aData);
2032   aPixel.Red := aData^;
2033   inc(aData);
2034 end;
2035 {$ENDREGION}
2036
2037 {$REGION TfdBGRA8}
2038 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2039 //TfdBGRA8////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2040 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2041 class function TfdBGRA8.GetFormat: TglBitmapFormat;
2042 begin
2043   result := tfBGRA8;
2044 end;
2045
2046 class function TfdBGRA8.GetPixelDesc: TglBitmapPixelDesc;
2047 begin
2048   with result do begin
2049     RedRange   := $000000FF; RedShift   := 16;
2050     GreenRange := $000000FF; GreenShift := 8;
2051     BlueRange  := $000000FF; BlueShift  := 0;
2052     AlphaRange := $000000FF; AlphaShift := 24;
2053   end;
2054 end;
2055
2056 class function TfdBGRA8.GetFormatDesc: TglBitmapFormatDesc;
2057 begin
2058   with result do begin
2059     Format         := GL_BGRA;
2060     InternalFormat := GL_RGBA8;
2061     DataType       := GL_UNSIGNED_BYTE;
2062   end;
2063 end;
2064
2065 class function TfdBGRA8.WithoutAlpha: TglBitmapFormat;
2066 begin
2067   result := tfBGR8;
2068 end;
2069
2070 class procedure TfdBGRA8.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
2071 begin
2072   aData^ := aPixel.Blue;
2073   inc(aData);
2074   aData^ := aPixel.Green;
2075   inc(aData);
2076   aData^ := aPixel.Red;
2077   inc(aData);
2078   aData^ := aPixel.Alpha;
2079   inc(aData);
2080 end;
2081
2082 class procedure TfdBGRA8.Unmap(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData);
2083 begin
2084   aPixel.Blue := aData^;
2085   inc(aData);
2086   aPixel.Green := aData^;
2087   inc(aData);
2088   aPixel.Red := aData^;
2089   inc(aData);
2090   aPixel.Alpha := aData^;
2091   inc(aData);
2092 end;
2093 {$ENDREGION}
2094
2095 {$REGION TglBitmap }
2096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2097 //TglBitmap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2099 function TglBitmap.GetHeight: Integer;
2100 begin
2101   if (ffY in fDimension.Fields) then
2102     result := fDimension.Y
2103   else
2104     result := -1;
2105 end;
2106
2107 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2108 function TglBitmap.GetWidth: Integer;
2109 begin
2110   if (ffX in fDimension.Fields) then
2111     result := fDimension.X
2112   else
2113     result := -1;
2114 end;
2115
2116 {$REGION Setter}
2117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2118 procedure TglBitmap.SetCustomData(const aValue: Pointer);
2119 begin
2120   if fCustomData = aValue then
2121     exit;
2122   fCustomData := aValue;
2123 end;
2124
2125 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2126 procedure TglBitmap.SetCustomName(const aValue: String);
2127 begin
2128   if fCustomName = aValue then
2129     exit;
2130   fCustomName := aValue;
2131 end;
2132
2133 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2134 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
2135 begin
2136   if fCustomNameW = aValue then
2137     exit;
2138   fCustomNameW := aValue;
2139 end;
2140
2141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2142 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
2143 begin
2144   if fDeleteTextureOnFree = aValue then
2145     exit;
2146   fDeleteTextureOnFree := aValue;
2147 end;
2148
2149 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2150 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
2151 begin
2152   if fFormat = aValue then
2153     exit;
2154   fFormat := aValue;
2155 end;
2156
2157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2158 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
2159 begin
2160   if fFreeDataAfterGenTexture = aValue then
2161     exit;
2162   fFreeDataAfterGenTexture := aValue;
2163 end;
2164
2165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2166 procedure TglBitmap.SetID(const aValue: Cardinal);
2167 begin
2168   if fID = aValue then
2169     exit;
2170   fID := aValue;
2171 end;
2172
2173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2174 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
2175 begin
2176   if fMipMap = aValue then
2177     exit;
2178   fMipMap := aValue;
2179 end;
2180
2181 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2182 procedure TglBitmap.SetTarget(const aValue: Cardinal);
2183 begin
2184   if fTarget = aValue then
2185     exit;
2186   fTarget := aValue;
2187 end;
2188
2189 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2190 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
2191 var
2192   MaxAnisotropic: Integer;
2193 begin
2194   fAnisotropic := Value;
2195   if (ID > 0) then begin
2196     if GL_EXT_texture_filter_anisotropic then begin
2197       if fAnisotropic > 0 then begin
2198         Bind(False);
2199         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
2200         if aValue > MaxAnisotropic then
2201           fAnisotropic := MaxAnisotropic;
2202         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
2203       end;
2204     end else begin
2205       fAnisotropic := 0;
2206     end;
2207   end;
2208 end;
2209 {$ENDREGION}
2210
2211 procedure TglBitmap.AfterConstruction;
2212 begin
2213   inherited AfterConstruction;
2214
2215   fID         := 0;
2216   fTarget     := 0;
2217   fIsResident := False;
2218
2219   fFormat                  := glBitmapGetDefaultFormat;
2220   fMipMap                  := glBitmapDefaultMipmap;
2221   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
2222   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
2223
2224   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
2225   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
2226 end;
2227
2228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2229 procedure TglBitmap.BeforeDestruction;
2230 begin
2231   SetDataPointer(nil, ifEmpty);
2232   if (ID > 0) and fDeleteTextureOnFree then
2233     glDeleteTextures(1, @ID);
2234   inherited BeforeDestruction;
2235 end;
2236
2237 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2238 procedure TglBitmap.CreateID;
2239 begin
2240   if ID <> 0 then
2241     glDeleteTextures(1, @ID);
2242   glGenTextures(1, @ID);
2243   Bind(false);
2244 end;
2245
2246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2247 procedure TglBitmap.SetupParameters(var aBuildWithGlu: Boolean);
2248 begin
2249   // Set Up Parameters
2250   SetWrap(fWrapS, fWrapT, fWrapR);
2251   SetFilter(fFilterMin, fFilterMag);
2252   SetAnisotropic(fAnisotropic);
2253   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
2254
2255   // Mip Maps Generation Mode
2256   aBuildWithGlu := False;
2257   if (MipMap = mmMipmap) then begin
2258     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
2259       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
2260     else
2261       BuildWithGlu := True;
2262   end else if (MipMap = mmMipmapGlu) then
2263     BuildWithGlu := True;
2264 end;
2265
2266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2267 procedure TglBitmap.SelectFormat(const aFormat: TglBitmapFormat; var glFormat, glInternalFormat, glType: Cardinal);
2268
2269   procedure Check12;
2270   begin
2271     if not GL_VERSION_1_2 then
2272       raise EglBitmapUnsupportedFormatFormat.Create('SelectFormat - You need at least OpenGL 1.2 to support these format.');
2273   end;
2274
2275 begin
2276   PIXEL_DESC_ALPHA12;
2277   glType := GL_UNSIGNED_BYTE;
2278   glInternalFormat := Cardinal(aFormat);
2279
2280   case aFormat of
2281     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16:
2282       glFormat := GL_ALPHA;
2283
2284     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16:
2285       glFormat := GL_LUMINANCE;
2286
2287     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8,
2288     tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16:
2289       glFormat := GL_LUMINANCE_ALPHA;
2290
2291     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16:
2292       glFormat := GL_RGB;
2293
2294     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16:
2295       glFormat := GL_RGBA;
2296
2297     tfDepth16, tfDepth24, tfDepth32:
2298       glFormat := GL_DEPTH_COMPONENT;
2299   else
2300     glFormat := 0;
2301   end;
2302
2303   case aFormat of
2304     tfRGBA4:
2305       glType := GL_UNSIGNED_SHORT_4_4_4_4;
2306     tfRGB5A1:
2307       glType := GL_UNSIGNED_SHORT_5_5_5_1;
2308     tfRG
2309   end;
2310
2311
2312   // selecting Format
2313   case DataFormat of
2314     ifAlpha:
2315       glFormat := GL_ALPHA;
2316     ifLuminance:
2317       glFormat := GL_LUMINANCE;
2318     ifDepth8:
2319       glFormat := GL_DEPTH_COMPONENT;
2320     ifLuminanceAlpha:
2321       glFormat := GL_LUMINANCE_ALPHA;
2322     ifBGR8:
2323       begin
2324         if (GL_VERSION_1_2 or GL_EXT_bgra) then begin
2325           glFormat := GL_BGR;
2326         end else begin
2327           if CanConvertImage then
2328             ConvertTo(tfRGB8);
2329           glFormat := GL_RGB;
2330         end;
2331       end;
2332     ifBGRA8:
2333       begin
2334         if (GL_VERSION_1_2 or GL_EXT_bgra) then begin
2335           glFormat := GL_BGRA;
2336         end else begin
2337           if CanConvertImage then
2338             ConvertTo(tfRGBA8);
2339           glFormat := GL_RGBA;
2340         end;
2341       end;
2342     tfRGB8:
2343       glFormat := GL_RGB;
2344     tfRGBA8:
2345       glFormat := GL_RGBA;
2346     tfRGBA4:
2347       begin
2348         Check12;
2349         glFormat := GL_BGRA;
2350         glType := GL_UNSIGNED_SHORT_4_4_4_4_REV;
2351       end;
2352     tfRGB5A1:
2353       begin
2354         Check12;
2355         glFormat := GL_BGRA;
2356         glType := GL_UNSIGNED_SHORT_1_5_5_5_REV;
2357       end;
2358     tfRGB10A2:
2359       begin
2360         Check12;
2361         glFormat := GL_BGRA;
2362         glType := GL_UNSIGNED_INT_2_10_10_10_REV;
2363       end;
2364     ifR5G6B5:
2365       begin
2366         Check12;
2367         glFormat := GL_RGB;
2368         glType := GL_UNSIGNED_SHORT_5_6_5;
2369       end;
2370     else
2371       glFormat := 0;
2372   end;
2373
2374   // Selecting InternalFormat
2375   case DataFormat of
2376     ifDXT1, ifDXT3, ifDXT5:
2377       begin
2378         if GL_EXT_texture_compression_s3tc then begin
2379           case DataFormat of
2380             ifDXT1:
2381               glInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
2382             ifDXT3:
2383               glInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
2384             ifDXT5:
2385               glInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
2386           end;
2387         end else begin
2388           // Compression isn't supported so convert to RGBA
2389           if CanConvertImage then
2390             ConvertTo(tfRGBA8);
2391           glFormat := GL_RGBA;
2392           glInternalFormat := GL_RGBA8;
2393         end;
2394       end;
2395     ifAlpha:
2396       begin
2397         case Format of
2398           tf4BitsPerChanel:
2399             glInternalFormat := GL_ALPHA4;
2400           tf8BitsPerChanel:
2401             glInternalFormat := GL_ALPHA8;
2402           tfCompressed:
2403             begin
2404               if (GL_ARB_texture_compression or GL_VERSION_1_3) then
2405                 glInternalFormat := GL_COMPRESSED_ALPHA
2406               else
2407                 glInternalFormat := GL_ALPHA;
2408             end;
2409           else
2410             glInternalFormat := GL_ALPHA;
2411         end;
2412       end;
2413     ifLuminance:
2414       begin
2415         case Format of
2416           tf4BitsPerChanel:
2417             glInternalFormat := GL_LUMINANCE4;
2418           tf8BitsPerChanel:
2419             glInternalFormat := GL_LUMINANCE8;
2420           tfCompressed:
2421             begin
2422               if (GL_ARB_texture_compression or GL_VERSION_1_3) then
2423                 glInternalFormat := GL_COMPRESSED_LUMINANCE
2424               else
2425                 glInternalFormat := GL_LUMINANCE;
2426             end;
2427           else
2428             glInternalFormat := GL_LUMINANCE;
2429         end;
2430       end;
2431     ifDepth8:
2432       begin
2433         glInternalFormat := GL_DEPTH_COMPONENT;
2434       end;
2435     ifLuminanceAlpha:
2436       begin
2437         case Format of
2438           tf4BitsPerChanel:
2439             glInternalFormat := GL_LUMINANCE4_ALPHA4;
2440           tf8BitsPerChanel:
2441             glInternalFormat := GL_LUMINANCE8_ALPHA8;
2442           tfCompressed:
2443             begin
2444               if (GL_ARB_texture_compression or GL_VERSION_1_3) then
2445                 glInternalFormat := GL_COMPRESSED_LUMINANCE_ALPHA
2446               else
2447                 glInternalFormat := GL_LUMINANCE_ALPHA;
2448             end;
2449           else
2450             glInternalFormat := GL_LUMINANCE_ALPHA;
2451         end;
2452       end;
2453     ifBGR8, tfRGB8:
2454       begin
2455         case Format of
2456           tf4BitsPerChanel:
2457             glInternalFormat := GL_RGB4;
2458           tf8BitsPerChanel:
2459             glInternalFormat := GL_RGB8;
2460           tfCompressed:
2461             begin
2462               if (GL_ARB_texture_compression or GL_VERSION_1_3) then begin
2463                 glInternalFormat := GL_COMPRESSED_RGB
2464               end else begin
2465                 if (GL_EXT_texture_compression_s3tc) then
2466                   glInternalFormat := GL_COMPRESSED_RGB_S3TC_DXT1_EXT
2467                 else
2468                   glInternalFormat := GL_RGB;
2469               end;
2470             end;
2471           else
2472             glInternalFormat := GL_RGB;
2473         end;
2474       end;
2475     ifBGRA8, tfRGBA8, tfRGBA4, tfRGB5A1, tfRGB10A2, ifR5G6B5:
2476       begin
2477         case Format of
2478           tf4BitsPerChanel:
2479             glInternalFormat := GL_RGBA4;
2480           tf8BitsPerChanel:
2481             glInternalFormat := GL_RGBA8;
2482           tfCompressed:
2483             begin
2484               if (GL_ARB_texture_compression or GL_VERSION_1_3) then begin
2485                 glInternalFormat := GL_COMPRESSED_RGBA
2486               end else begin
2487                 if (GL_EXT_texture_compression_s3tc) then
2488                   glInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT
2489                 else
2490                   glInternalFormat := GL_RGBA;
2491               end;
2492             end;
2493           else
2494             glInternalFormat := GL_RGBA;
2495         end;
2496       end;
2497   end;
2498 end;
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2517 constructor TglBitmap.Create;
2518 begin
2519   {$IFNDEF GLB_NO_NATIVE_GL}
2520     ReadOpenGLExtensions;
2521   {$ENDIF}
2522
2523   if (ClassType = TglBitmap) then
2524     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
2525
2526   inherited Create;
2527 end;
2528
2529
2530 constructor TglBitmap.Create(FileName: String);
2531 begin
2532   Create;
2533   LoadFromFile(FileName);
2534 end;
2535
2536
2537 constructor TglBitmap.Create(Stream: TStream);
2538 begin
2539   Create;
2540   LoadFromStream(Stream);
2541 end;
2542
2543
2544 {$IFDEF GLB_DELPHI}
2545 constructor TglBitmap.CreateFromResourceName(Instance: Cardinal; Resource: String; ResType: PChar);
2546 begin
2547   Create;
2548   LoadFromResource(Instance, Resource, ResType);
2549 end;
2550
2551
2552 constructor TglBitmap.Create(Instance: Cardinal; Resource: String; ResType: PChar);
2553 begin
2554   Create;
2555   LoadFromResource(Instance, Resource, ResType);
2556 end;
2557
2558
2559
2560 constructor TglBitmap.Create(Instance: Cardinal; ResourceID: Integer; ResType: PChar);
2561 begin
2562   Create;
2563   LoadFromResourceID(Instance, ResourceID, ResType);
2564 end;
2565 {$ENDIF}
2566
2567
2568 constructor TglBitmap.Create(Size: TglBitmapPixelPosition;
2569   Format: TglBitmapFormat);
2570 var
2571   Image: pByte;
2572   ImageSize: Integer;
2573 begin
2574   Create;
2575
2576   ImageSize := FormatGetImageSize(Size, Format);
2577   GetMem(Image, ImageSize);
2578   try
2579     FillChar(Image^, ImageSize, #$FF);
2580
2581     SetDataPointer(Image, Format, Size.X, Size.Y);
2582   except
2583     FreeMem(Image);
2584     raise;
2585   end;
2586 end;
2587
2588
2589 constructor TglBitmap.Create(Size: TglBitmapPixelPosition;
2590   Format: TglBitmapFormat; Func: TglBitmapFunction; CustomData: Pointer);
2591 begin
2592   Create;
2593   LoadFromFunc(Size, Func, Format, CustomData);
2594 end;
2595
2596
2597 function TglBitmap.Clone: TglBitmap;
2598 var
2599   Temp: TglBitmap;
2600   TempPtr: pByte;
2601   Size: Integer;
2602 begin
2603   Temp := ClassType.Create as TglBitmap;
2604   try
2605     // copy texture data if assigned
2606     if Assigned(Data) then begin
2607       Size := FormatGetImageSize(glBitmapPosition(Width, Height), InternalFormat);
2608
2609       GetMem(TempPtr, Size);
2610       try
2611         Move(Data^, TempPtr^, Size);
2612         Temp.SetDataPointer(TempPtr, InternalFormat, Width, Height);
2613       except
2614         FreeMem(TempPtr);
2615         raise;
2616       end;
2617     end else
2618       Temp.SetDataPointer(nil, InternalFormat, Width, Height);
2619
2620         // copy properties
2621     Temp.fID := ID;
2622     Temp.fTarget := Target;
2623     Temp.fFormat := Format;
2624     Temp.fMipMap := MipMap;
2625     Temp.fAnisotropic := Anisotropic;
2626     Temp.fBorderColor := fBorderColor;
2627     Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
2628     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
2629     Temp.fFilterMin := fFilterMin;
2630     Temp.fFilterMag := fFilterMag;
2631     Temp.fWrapS := fWrapS;
2632     Temp.fWrapT := fWrapT;
2633     Temp.fWrapR := fWrapR;
2634     Temp.fFilename := fFilename;
2635     Temp.fCustomName := fCustomName;
2636     Temp.fCustomNameW := fCustomNameW;
2637     Temp.fCustomDataPointer := fCustomDataPointer;
2638
2639     Result := Temp;
2640   except
2641     FreeAndNil(Temp);
2642     raise;
2643   end;
2644 end;
2645
2646
2647 procedure TglBitmap.LoadFromFile(const aFileName: String);
2648 var
2649   FS: TFileStream;
2650 begin
2651   fFilename := FileName;
2652
2653   FS := TFileStream.Create(FileName, fmOpenRead);
2654   try
2655     FS.Position := 0;
2656
2657     LoadFromStream(FS);
2658   finally
2659     FS.Free;
2660   end;
2661 end;
2662
2663
2664 procedure TglBitmap.LoadFromStream(const aStream: TStream);
2665 begin
2666   {$IFDEF GLB_SUPPORT_PNG_READ}
2667   if not LoadPNG(Stream) then
2668   {$ENDIF}
2669   {$IFDEF GLB_SUPPORT_JPEG_READ}
2670   if not LoadJPEG(Stream) then
2671   {$ENDIF}
2672   if not LoadDDS(Stream) then
2673   if not LoadTGA(Stream) then
2674   if not LoadBMP(Stream) then
2675     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
2676 end;
2677
2678
2679 {$IFDEF GLB_DELPHI}
2680 procedure TglBitmap.LoadFromResource(Instance: Cardinal; Resource: String; ResType: PChar);
2681 var
2682   RS: TResourceStream;
2683   TempPos: Integer;
2684   ResTypeStr: String;
2685   TempResType: PChar;
2686 begin
2687   if Assigned(ResType) then
2688     TempResType := ResType
2689   else
2690     begin
2691       TempPos := Pos('.', Resource);
2692       ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
2693       Resource   := UpperCase(Copy(Resource, 0, TempPos -1));
2694       TempResType := PChar(ResTypeStr);
2695     end;
2696
2697   RS := TResourceStream.Create(Instance, Resource, TempResType);
2698   try
2699     LoadFromStream(RS);
2700   finally
2701     RS.Free;
2702   end;
2703 end;
2704
2705
2706 procedure TglBitmap.LoadFromResourceID(Instance: Cardinal; ResourceID: Integer; ResType: PChar);
2707 var
2708   RS: TResourceStream;
2709 begin
2710   RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
2711   try
2712     LoadFromStream(RS);
2713   finally
2714     RS.Free;
2715   end;
2716 end;
2717 {$ENDIF}
2718
2719
2720
2721 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition;
2722   const aFunc: TglBitmapFunction; const aFormat: TglBitmapFormat;
2723   const aArgs: PtrInt);
2724 var
2725   Image: pByte;
2726   ImageSize: Integer;
2727 begin
2728   ImageSize := FormatGetImageSize(Size, Format);
2729   GetMem(Image, ImageSize);
2730   try
2731     FillChar(Image^, ImageSize, #$FF);
2732
2733     SetDataPointer(Image, Format, Size.X, Size.Y);
2734   except
2735     FreeMem(Image);
2736     raise;
2737   end;
2738
2739   AddFunc(Self, Func, False, Format, CustomData)
2740 end;
2741
2742
2743 procedure TglBitmap.SaveToFile(const aFileName: String;
2744   const aFileType: TglBitmapFileType);
2745 var
2746   FS: TFileStream;
2747 begin
2748   FS := TFileStream.Create(FileName, fmCreate);
2749   try
2750     FS.Position := 0;
2751     SaveToStream(FS, FileType);
2752   finally
2753     FS.Free;
2754   end;
2755 end;
2756
2757
2758 procedure TglBitmap.SaveToStream(const aStream: TStream;
2759   const aFileType: TglBitmapFileType);
2760 begin
2761   case FileType of
2762     {$IFDEF GLB_SUPPORT_PNG_WRITE}
2763     ftPNG:  SavePng(Stream);
2764     {$ENDIF}
2765     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
2766     ftJPEG: SaveJPEG(Stream);
2767     {$ENDIF}
2768     ftDDS:  SaveDDS(Stream);
2769     ftTGA:  SaveTGA(Stream);
2770     ftBMP:  SaveBMP(Stream);
2771   end;
2772 end;
2773
2774
2775 {$IFDEF GLB_SDL}
2776 function TglBitmap.AssignToSurface(out Surface: PSDL_Surface): boolean;
2777 var
2778   Row, RowSize: Integer;
2779   pSource, pData: PByte;
2780   TempDepth: Integer;
2781   Pix: TglBitmapPixelData;
2782
2783   function GetRowPointer(Row: Integer): pByte;
2784   begin
2785     Result := Surface.pixels;
2786     Inc(Result, Row * RowSize);
2787   end;
2788
2789 begin
2790   Result := False;
2791
2792   if not FormatIsUncompressed(InternalFormat) then
2793     raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
2794
2795   if Assigned(Data) then begin
2796     case Trunc(FormatGetSize(InternalFormat)) of
2797       1: TempDepth :=  8;
2798       2: TempDepth := 16;
2799       3: TempDepth := 24;
2800       4: TempDepth := 32;
2801       else
2802         raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
2803     end;
2804
2805     FormatPreparePixel(Pix, InternalFormat);
2806
2807     with Pix.PixelDesc do
2808       Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth, RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);
2809
2810     pSource := Data;
2811     RowSize := Trunc(FileWidth * FormatGetSize(InternalFormat));
2812
2813     for Row := 0 to FileHeight -1 do begin
2814       pData := GetRowPointer(Row);
2815
2816       if Assigned(pData) then begin
2817         Move(pSource^, pData^, RowSize);
2818         Inc(pSource, RowSize);
2819       end;
2820     end;
2821
2822     Result := True;
2823   end;
2824 end;
2825
2826
2827 function TglBitmap.AssignFromSurface(const Surface: PSDL_Surface): boolean;
2828 var
2829   pSource, pData, pTempData: PByte;
2830   Row, RowSize, TempWidth, TempHeight: Integer;
2831   IntFormat: TglBitmapInternalFormat;
2832
2833   function GetRowPointer(Row: Integer): pByte;
2834   begin
2835     Result := Surface^.pixels;
2836     Inc(Result, Row * RowSize);
2837   end;
2838
2839 begin
2840   Result := False;
2841
2842   if (Assigned(Surface)) then begin
2843     with Surface^.format^ do begin
2844       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifLuminance) then
2845         IntFormat := ifLuminance
2846       else
2847
2848       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifLuminanceAlpha) then
2849         IntFormat := ifLuminanceAlpha
2850       else
2851
2852       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGBA4) then
2853         IntFormat := ifRGBA4
2854       else
2855
2856       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifR5G6B5) then
2857         IntFormat := ifR5G6B5
2858       else
2859
2860       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGB5A1) then
2861         IntFormat := ifRGB5A1
2862       else
2863
2864       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifBGR8) then
2865         IntFormat := ifBGR8
2866       else
2867
2868       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGB8) then
2869         IntFormat := ifRGB8
2870       else
2871
2872       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifBGRA8) then
2873         IntFormat := ifBGRA8
2874       else
2875
2876       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGBA8) then
2877         IntFormat := ifRGBA8
2878       else
2879
2880       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGB10A2) then
2881         IntFormat := ifRGB10A2
2882       else
2883         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
2884     end;
2885
2886     TempWidth := Surface^.w;
2887     TempHeight := Surface^.h;
2888
2889     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
2890
2891     GetMem(pData, TempHeight * RowSize);
2892     try
2893       pTempData := pData;
2894
2895       for Row := 0 to TempHeight -1 do begin
2896         pSource := GetRowPointer(Row);
2897
2898         if (Assigned(pSource)) then begin
2899           Move(pSource^, pTempData^, RowSize);
2900           Inc(pTempData, RowSize);
2901         end;
2902       end;
2903
2904       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
2905
2906       Result := True;
2907     except
2908       FreeMem(pData);
2909       raise;
2910     end;
2911   end;
2912 end;
2913
2914
2915 function TglBitmap.AssignAlphaToSurface(out Surface: PSDL_Surface): boolean;
2916 var
2917   Row, Col, AlphaInterleave: Integer;
2918   pSource, pDest: PByte;
2919
2920   function GetRowPointer(Row: Integer): pByte;
2921   begin
2922     Result := Surface.pixels;
2923     Inc(Result, Row * Width);
2924   end;
2925
2926 begin
2927   Result := False;
2928
2929   if Assigned(Data) then begin
2930     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifBGRA8, ifRGBA8] then begin
2931       Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
2932
2933       case InternalFormat of
2934         ifLuminanceAlpha:
2935           AlphaInterleave := 1;
2936         ifBGRA8, ifRGBA8:
2937           AlphaInterleave := 3;
2938         else
2939           AlphaInterleave := 0;
2940       end;
2941
2942       // Copy Data
2943       pSource := Data;
2944
2945       for Row := 0 to Height -1 do begin
2946         pDest := GetRowPointer(Row);
2947
2948         if Assigned(pDest) then begin
2949           for Col := 0 to Width -1 do begin
2950             Inc(pSource, AlphaInterleave);
2951             pDest^ := pSource^;
2952             Inc(pDest);
2953             Inc(pSource);
2954           end;
2955         end;
2956       end;
2957
2958       Result := True;
2959     end;
2960   end;
2961 end;
2962
2963
2964 function TglBitmap.AddAlphaFromSurface(Surface: PSDL_Surface; Func: TglBitmapFunction; CustomData: Pointer): boolean;
2965 var
2966   glBitmap: TglBitmap2D;
2967 begin
2968   glBitmap := TglBitmap2D.Create;
2969   try
2970     glBitmap.AssignFromSurface(Surface);
2971
2972     Result := AddAlphaFromglBitmap(glBitmap, Func, CustomData);
2973   finally
2974     glBitmap.Free;
2975   end;
2976 end;
2977 {$ENDIF}
2978
2979
2980 {$IFDEF GLB_DELPHI}
2981 function TglBitmap.AssignFromBitmap(const Bitmap: TBitmap): boolean;
2982 var
2983   pSource, pData, pTempData: PByte;
2984   Row, RowSize, TempWidth, TempHeight: Integer;
2985   IntFormat: TglBitmapInternalFormat;
2986 begin
2987   Result := False;
2988
2989   if (Assigned(Bitmap)) then begin
2990     case Bitmap.PixelFormat of
2991       pf8bit:
2992         IntFormat := ifLuminance;
2993       pf15bit:
2994         IntFormat := ifRGB5A1;
2995       pf16bit:
2996         IntFormat := ifR5G6B5;
2997       pf24bit:
2998         IntFormat := ifBGR8;
2999       pf32bit:
3000         IntFormat := ifBGRA8;
3001       else
3002         raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
3003     end;
3004
3005     TempWidth := Bitmap.Width;
3006     TempHeight := Bitmap.Height;
3007
3008     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
3009
3010     GetMem(pData, TempHeight * RowSize);
3011     try
3012       pTempData := pData;
3013
3014       for Row := 0 to TempHeight -1 do begin
3015         pSource := Bitmap.Scanline[Row];
3016
3017         if (Assigned(pSource)) then begin
3018           Move(pSource^, pTempData^, RowSize);
3019           Inc(pTempData, RowSize);
3020         end;
3021       end;
3022
3023       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
3024
3025       Result := True;
3026     except
3027       FreeMem(pData);
3028       raise;
3029     end;
3030   end;
3031 end;
3032
3033
3034 function TglBitmap.AssignToBitmap(const Bitmap: TBitmap): boolean;
3035 var
3036   Row: Integer;
3037   pSource, pData: PByte;
3038 begin
3039   Result := False;
3040
3041   if Assigned(Data) then begin
3042     if Assigned(Bitmap) then begin
3043       Bitmap.Width := Width;
3044       Bitmap.Height := Height;
3045
3046       case InternalFormat of
3047         ifAlpha, ifLuminance, ifDepth8:
3048           begin
3049             Bitmap.PixelFormat := pf8bit;
3050             Bitmap.Palette := CreateGrayPalette;
3051           end;
3052         ifRGB5A1:
3053           Bitmap.PixelFormat := pf15bit;
3054         ifR5G6B5:
3055           Bitmap.PixelFormat := pf16bit;
3056         ifRGB8, ifBGR8:
3057           Bitmap.PixelFormat := pf24bit;
3058         ifRGBA8, ifBGRA8:
3059           Bitmap.PixelFormat := pf32bit;
3060         else
3061           raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
3062       end;
3063
3064       pSource := Data;
3065       for Row := 0 to FileHeight -1 do begin
3066         pData := Bitmap.Scanline[Row];
3067
3068         Move(pSource^, pData^, fRowSize);
3069         Inc(pSource, fRowSize);
3070
3071         // swap RGB(A) to BGR(A)
3072         if InternalFormat in [ifRGB8, ifRGBA8] then
3073           SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
3074       end;
3075
3076       Result := True;
3077     end;
3078   end;
3079 end;
3080
3081
3082 function TglBitmap.AssignAlphaToBitmap(const Bitmap: TBitmap): boolean;
3083 var
3084   Row, Col, AlphaInterleave: Integer;
3085   pSource, pDest: PByte;
3086 begin
3087   Result := False;
3088
3089   if Assigned(Data) then begin
3090     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
3091       if Assigned(Bitmap) then begin
3092         Bitmap.PixelFormat := pf8bit;
3093         Bitmap.Palette := CreateGrayPalette;
3094         Bitmap.Width := Width;
3095         Bitmap.Height := Height;
3096
3097         case InternalFormat of
3098           ifLuminanceAlpha:
3099             AlphaInterleave := 1;
3100           ifRGBA8, ifBGRA8:
3101             AlphaInterleave := 3;
3102           else
3103             AlphaInterleave := 0;
3104         end;
3105
3106         // Copy Data
3107         pSource := Data;
3108
3109         for Row := 0 to Height -1 do begin
3110           pDest := Bitmap.Scanline[Row];
3111
3112           if Assigned(pDest) then begin
3113             for Col := 0 to Width -1 do begin
3114               Inc(pSource, AlphaInterleave);
3115               pDest^ := pSource^;
3116               Inc(pDest);
3117               Inc(pSource);
3118             end;
3119           end;
3120         end;
3121
3122         Result := True;
3123       end;
3124     end;
3125   end;
3126 end;
3127
3128
3129 function TglBitmap.AddAlphaFromBitmap(Bitmap: TBitmap; Func: TglBitmapFunction; CustomData: Pointer): boolean;
3130 var
3131   glBitmap: TglBitmap2D;
3132 begin
3133   glBitmap := TglBitmap2D.Create;
3134   try
3135     glBitmap.AssignFromBitmap(Bitmap);
3136
3137     Result := AddAlphaFromglBitmap(glBitmap, Func, CustomData);
3138   finally
3139     glBitmap.Free;
3140   end;
3141 end;
3142 {$ENDIF}
3143
3144
3145 function TglBitmap.AddAlphaFromFile(FileName: String; Func: TglBitmapFunction; CustomData: Pointer): boolean;
3146 var
3147   FS: TFileStream;
3148 begin
3149   FS := TFileStream.Create(FileName, fmOpenRead);
3150   try
3151     Result := AddAlphaFromStream(FS, Func, CustomData);
3152   finally
3153     FS.Free;
3154   end;
3155 end;
3156
3157
3158 function TglBitmap.AddAlphaFromStream(Stream: TStream; Func: TglBitmapFunction; CustomData: Pointer): boolean;
3159 var
3160   glBitmap: TglBitmap2D;
3161 begin
3162   glBitmap := TglBitmap2D.Create(Stream);
3163   try
3164     Result := AddAlphaFromglBitmap(glBitmap, Func, CustomData);
3165   finally
3166     glBitmap.Free;
3167   end;
3168 end;
3169
3170
3171 {$IFDEF GLB_DELPHI}
3172 function TglBitmap.AddAlphaFromResource(Instance: Cardinal; Resource: String;
3173   ResType: PChar; Func: TglBitmapFunction; CustomData: Pointer): boolean;
3174 var
3175   RS: TResourceStream;
3176   TempPos: Integer;
3177   ResTypeStr: String;
3178   TempResType: PChar;
3179 begin
3180   if Assigned(ResType) then
3181     TempResType := ResType
3182   else
3183     begin
3184       TempPos := Pos('.', Resource);
3185       ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
3186       Resource   := UpperCase(Copy(Resource, 0, TempPos -1));
3187       TempResType := PChar(ResTypeStr);
3188     end;
3189
3190   RS := TResourceStream.Create(Instance, Resource, TempResType);
3191   try
3192     Result := AddAlphaFromStream(RS, Func, CustomData);
3193   finally
3194     RS.Free;
3195   end;
3196 end;
3197
3198
3199 function TglBitmap.AddAlphaFromResourceID(Instance: Cardinal; ResourceID: Integer;
3200   ResType: PChar; Func: TglBitmapFunction; CustomData: Pointer): boolean;
3201 var
3202   RS: TResourceStream;
3203 begin
3204   RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
3205   try
3206     Result := AddAlphaFromStream(RS, Func, CustomData);
3207   finally
3208     RS.Free;
3209   end;
3210 end;
3211 {$ENDIF}
3212
3213
3214 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3215 begin
3216   with FuncRec do begin
3217     Dest.Red   := Source.Red;
3218     Dest.Green := Source.Green;
3219     Dest.Blue  := Source.Blue;
3220
3221     with TglBitmapPixelData(CustomData^) do
3222       if ((Dest.Red   <= Red  ) and (Dest.Red   >= PixelDesc.RedRange  ) and
3223           (Dest.Green <= Green) and (Dest.Green >= PixelDesc.GreenRange) and
3224           (Dest.Blue  <= Blue ) and (Dest.Blue  >= PixelDesc.BlueRange )) then
3225         Dest.Alpha := 0
3226       else
3227         Dest.Alpha := Dest.PixelDesc.AlphaRange;
3228   end;
3229 end;
3230
3231
3232 function TglBitmap.AddAlphaFromColorKey(Red, Green, Blue: Byte; Deviation: Byte
3233   ): Boolean;
3234 begin
3235   Result := AddAlphaFromColorKeyFloat(Red / $FF, Green / $FF, Blue / $FF, Deviation / $FF);
3236 end;
3237
3238
3239 function TglBitmap.AddAlphaFromColorKeyRange(Red, Green, Blue: Cardinal; Deviation: Cardinal = 0): Boolean;
3240 var
3241   PixelData: TglBitmapPixelData;
3242 begin
3243   FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
3244
3245   Result := AddAlphaFromColorKeyFloat(
3246     Red   / PixelData.PixelDesc.RedRange,
3247     Green / PixelData.PixelDesc.GreenRange,
3248     Blue  / PixelData.PixelDesc.BlueRange,
3249     Deviation / Max(PixelData.PixelDesc.RedRange, Max(PixelData.PixelDesc.GreenRange, PixelData.PixelDesc.BlueRange)));
3250 end;
3251
3252
3253 function TglBitmap.AddAlphaFromColorKeyFloat(Red, Green, Blue: Single; Deviation: Single = 0): Boolean;
3254 var
3255   TempR, TempG, TempB: Cardinal;
3256   PixelData: TglBitmapPixelData;
3257 begin
3258   FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
3259
3260   // Calculate Colorrange
3261   with PixelData.PixelDesc do begin
3262     TempR := Trunc(RedRange   * Deviation);
3263     TempG := Trunc(GreenRange * Deviation);
3264     TempB := Trunc(BlueRange  * Deviation);
3265
3266     PixelData.Red   := Min(RedRange,   Trunc(RedRange   * Red)   + TempR);
3267     RedRange        := Max(0,          Trunc(RedRange   * Red)   - TempR);
3268     PixelData.Green := Min(GreenRange, Trunc(GreenRange * Green) + TempG);
3269     GreenRange      := Max(0,          Trunc(GreenRange * Green) - TempG);
3270     PixelData.Blue  := Min(BlueRange,  Trunc(BlueRange  * Blue)  + TempB);
3271     BlueRange       := Max(0,          Trunc(BlueRange  * Blue)  - TempB);
3272     PixelData.Alpha := 0;
3273     AlphaRange      := 0;
3274   end;
3275
3276   Result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
3277 end;
3278
3279
3280 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3281 begin
3282   with FuncRec do begin
3283     Dest.Red   := Source.Red;
3284     Dest.Green := Source.Green;
3285     Dest.Blue  := Source.Blue;
3286
3287     with TglBitmapPixelData(CustomData^) do
3288       Dest.Alpha := Alpha;
3289   end;
3290 end;
3291
3292
3293 function TglBitmap.AddAlphaFromValue(Alpha: Byte): Boolean;
3294 begin
3295   Result := AddAlphaFromValueFloat(Alpha / $FF);
3296 end;
3297
3298
3299 function TglBitmap.AddAlphaFromValueFloat(Alpha: Single): Boolean;
3300 var
3301   PixelData: TglBitmapPixelData;
3302 begin
3303   FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
3304
3305   with PixelData.PixelDesc do
3306     PixelData.Alpha := Min(AlphaRange, Max(0, Round(AlphaRange * Alpha)));
3307
3308   Result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData);
3309 end;
3310
3311
3312 function TglBitmap.AddAlphaFromValueRange(Alpha: Cardinal): Boolean;
3313 var
3314   PixelData: TglBitmapPixelData;
3315 begin
3316   FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
3317
3318   Result := AddAlphaFromValueFloat(Alpha / PixelData.PixelDesc.AlphaRange);
3319 end;
3320
3321
3322 procedure glBitmapInvertFunc(var FuncRec: TglBitmapFunctionRec);
3323 begin
3324   with FuncRec do begin
3325     Dest.Red   := Source.Red;
3326     Dest.Green := Source.Green;
3327     Dest.Blue  := Source.Blue;
3328     Dest.Alpha := Source.Alpha;
3329
3330     if (Integer(CustomData) and $1 > 0) then begin
3331       Dest.Red   := Dest.Red   xor Dest.PixelDesc.RedRange;
3332       Dest.Green := Dest.Green xor Dest.PixelDesc.GreenRange;
3333       Dest.Blue  := Dest.Blue  xor Dest.PixelDesc.BlueRange;
3334     end;
3335
3336     if (Integer(CustomData) and $2 > 0) then begin
3337       Dest.Alpha := Dest.Alpha xor Dest.PixelDesc.AlphaRange;
3338     end;
3339   end;
3340 end;
3341
3342
3343 procedure TglBitmap.Invert(UseRGB: Boolean; UseAlpha: Boolean);
3344 begin
3345   if ((UseRGB) or (UseAlpha)) then
3346     AddFunc(glBitmapInvertFunc, False, Pointer(Integer(UseAlpha) shl 1 or Integer(UseRGB)));
3347 end;
3348
3349
3350 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
3351 begin
3352   case Min of
3353     GL_NEAREST:
3354       fFilterMin := GL_NEAREST;
3355     GL_LINEAR:
3356       fFilterMin := GL_LINEAR;
3357     GL_NEAREST_MIPMAP_NEAREST:
3358       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
3359     GL_LINEAR_MIPMAP_NEAREST:
3360       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
3361     GL_NEAREST_MIPMAP_LINEAR:
3362       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
3363     GL_LINEAR_MIPMAP_LINEAR:
3364       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
3365     else
3366       raise EglBitmapException.Create('SetFilter - Unknow Minfilter.');
3367   end;
3368
3369   case Mag of
3370     GL_NEAREST:
3371       fFilterMag := GL_NEAREST;
3372     GL_LINEAR:
3373       fFilterMag := GL_LINEAR;
3374     else
3375       raise EglBitmapException.Create('SetFilter - Unknow Magfilter.');
3376   end;
3377
3378   // If texture is created then assign filter
3379   if ID > 0 then begin
3380     Bind(False);
3381
3382     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
3383
3384     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE_ARB) then begin
3385       case fFilterMin of
3386         GL_NEAREST, GL_LINEAR:
3387           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
3388         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
3389           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
3390         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
3391           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
3392       end;
3393     end else
3394       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
3395   end;
3396 end;
3397
3398
3399 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal;
3400   const R: Cardinal);
3401 begin
3402   case S of
3403     GL_CLAMP:
3404       fWrapS := GL_CLAMP;
3405     GL_REPEAT:
3406       fWrapS := GL_REPEAT;
3407     GL_CLAMP_TO_EDGE:
3408       begin
3409         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
3410           fWrapS := GL_CLAMP_TO_EDGE
3411         else
3412           fWrapS := GL_CLAMP;
3413       end;
3414     GL_CLAMP_TO_BORDER:
3415       begin
3416         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
3417           fWrapS := GL_CLAMP_TO_BORDER
3418         else
3419           fWrapS := GL_CLAMP;
3420       end;
3421     GL_MIRRORED_REPEAT:
3422       begin
3423         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
3424           fWrapS := GL_MIRRORED_REPEAT
3425         else
3426           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
3427       end;
3428     else
3429       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
3430   end;
3431
3432   case T of
3433     GL_CLAMP:
3434       fWrapT := GL_CLAMP;
3435     GL_REPEAT:
3436       fWrapT := GL_REPEAT;
3437     GL_CLAMP_TO_EDGE:
3438       begin
3439         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
3440           fWrapT := GL_CLAMP_TO_EDGE
3441         else
3442           fWrapT := GL_CLAMP;
3443       end;
3444     GL_CLAMP_TO_BORDER:
3445       begin
3446         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
3447           fWrapT := GL_CLAMP_TO_BORDER
3448         else
3449           fWrapT := GL_CLAMP;
3450       end;
3451     GL_MIRRORED_REPEAT:
3452       begin
3453         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
3454           fWrapT := GL_MIRRORED_REPEAT
3455         else
3456           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (T).');
3457       end;
3458     else
3459       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (T).');
3460   end;
3461
3462   case R of
3463     GL_CLAMP:
3464       fWrapR := GL_CLAMP;
3465     GL_REPEAT:
3466       fWrapR := GL_REPEAT;
3467     GL_CLAMP_TO_EDGE:
3468       begin
3469         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
3470           fWrapR := GL_CLAMP_TO_EDGE
3471         else
3472           fWrapR := GL_CLAMP;
3473       end;
3474     GL_CLAMP_TO_BORDER:
3475       begin
3476         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
3477           fWrapR := GL_CLAMP_TO_BORDER
3478         else
3479           fWrapR := GL_CLAMP;
3480       end;
3481     GL_MIRRORED_REPEAT:
3482       begin
3483         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
3484           fWrapR := GL_MIRRORED_REPEAT
3485         else
3486           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (R).');
3487       end;
3488     else
3489       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (R).');
3490   end;
3491
3492   if ID > 0 then begin
3493     Bind (False);
3494     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
3495     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
3496     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
3497   end;
3498 end;
3499
3500
3501 procedure TglBitmap.SetDataPointer(NewData: pByte;
3502   Format: TglBitmapFormat; Width: Integer; Height: Integer);
3503 begin
3504   // Data
3505   if Data <> NewData then begin
3506     if (Assigned(Data))
3507       then FreeMem(Data);
3508
3509     fData := NewData;
3510   end;
3511
3512   if Data = nil then begin
3513     fInternalFormat := ifEmpty;
3514     fPixelSize := 0;
3515     fRowSize := 0;
3516   end else begin
3517     if Width <> -1 then begin
3518       fDimension.Fields := fDimension.Fields + [ffX];
3519       fDimension.X := Width;
3520     end;
3521
3522     if Height <> -1 then begin
3523       fDimension.Fields := fDimension.Fields + [ffY];
3524       fDimension.Y := Height;
3525     end;
3526
3527     fInternalFormat := Format;
3528     fPixelSize := Trunc(FormatGetSize(InternalFormat));
3529     fRowSize :=  Trunc(FormatGetSize(InternalFormat) * Self.Width);
3530   end;
3531 end;
3532
3533 {$IFDEF GLB_SUPPORT_PNG_READ}
3534 {$IFDEF GLB_LIB_PNG}
3535 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
3536 begin
3537   TStream(png_get_io_ptr(png)).Read(buffer^, size);
3538 end;
3539 {$ENDIF}
3540
3541
3542 function TglBitmap.LoadPNG(Stream: TStream): Boolean;
3543 {$IFDEF GLB_SDL_IMAGE}
3544 var
3545   Surface: PSDL_Surface;
3546   RWops: PSDL_RWops;
3547 begin
3548   Result := False;
3549
3550   RWops := glBitmapCreateRWops(Stream);
3551   try
3552     if IMG_isPNG(RWops) > 0 then begin
3553       Surface := IMG_LoadPNG_RW(RWops);
3554       try
3555         AssignFromSurface(Surface);
3556         Result := True;
3557       finally
3558         SDL_FreeSurface(Surface);
3559       end;
3560     end;
3561   finally
3562     SDL_FreeRW(RWops);
3563   end;
3564 end;
3565 {$ENDIF}
3566 {$IFDEF GLB_LIB_PNG}
3567 var
3568   StreamPos: Int64;
3569   signature: array [0..7] of byte;
3570   png: png_structp;
3571   png_info: png_infop;
3572
3573   TempHeight, TempWidth: Integer;
3574   Format: TglBitmapInternalFormat;
3575
3576   png_data: pByte;
3577   png_rows: array of pByte;
3578   Row, LineSize: Integer;
3579 begin
3580   Result := False;
3581
3582   if not init_libPNG then
3583     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
3584
3585   try
3586     // signature
3587     StreamPos := Stream.Position;
3588     Stream.Read(signature, 8);
3589     Stream.Position := StreamPos;
3590
3591     if png_check_sig(@signature, 8) <> 0 then begin
3592       // png read struct
3593       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
3594       if png = nil then
3595         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
3596
3597       // png info
3598       png_info := png_create_info_struct(png);
3599       if png_info = nil then begin
3600         png_destroy_read_struct(@png, nil, nil);
3601         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
3602       end;
3603
3604       // set read callback
3605       png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
3606
3607       // read informations
3608       png_read_info(png, png_info);
3609
3610       // size
3611       TempHeight := png_get_image_height(png, png_info);
3612       TempWidth := png_get_image_width(png, png_info);
3613
3614       // format
3615       case png_get_color_type(png, png_info) of
3616         PNG_COLOR_TYPE_GRAY:
3617           Format := ifLuminance;
3618         PNG_COLOR_TYPE_GRAY_ALPHA:
3619           Format := ifLuminanceAlpha;
3620         PNG_COLOR_TYPE_RGB:
3621           Format := ifRGB8;
3622         PNG_COLOR_TYPE_RGB_ALPHA:
3623           Format := ifRGBA8;
3624         else
3625           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
3626       end;
3627
3628       // cut upper 8 bit from 16 bit formats
3629       if png_get_bit_depth(png, png_info) > 8 then
3630         png_set_strip_16(png);
3631
3632       // expand bitdepth smaller than 8
3633       if png_get_bit_depth(png, png_info) < 8 then
3634         png_set_expand(png);
3635
3636       // allocating mem for scanlines
3637       LineSize := png_get_rowbytes(png, png_info);
3638       GetMem(png_data, TempHeight * LineSize);
3639       try
3640         SetLength(png_rows, TempHeight);
3641         for Row := Low(png_rows) to High(png_rows) do begin
3642           png_rows[Row] := png_data;
3643           Inc(png_rows[Row], Row * LineSize);
3644         end;
3645
3646         // read complete image into scanlines
3647         png_read_image(png, @png_rows[0]);
3648
3649         // read end
3650         png_read_end(png, png_info);
3651
3652         // destroy read struct
3653         png_destroy_read_struct(@png, @png_info, nil);
3654
3655         SetLength(png_rows, 0);
3656
3657         // set new data
3658         SetDataPointer(png_data, Format, TempWidth, TempHeight);
3659
3660         Result := True;
3661       except
3662         FreeMem(png_data);
3663         raise;
3664       end;
3665     end;
3666   finally
3667     quit_libPNG;
3668   end;
3669 end;
3670 {$ENDIF}
3671 {$IFDEF GLB_PNGIMAGE}
3672 var
3673   StreamPos: Int64;
3674   Png: TPNGObject;
3675   Header: Array[0..7] of Byte;
3676   Row, Col, PixSize, LineSize: Integer;
3677   NewImage, pSource, pDest, pAlpha: pByte;
3678   Format: TglBitmapInternalFormat;
3679
3680 const
3681   PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
3682
3683 begin
3684   Result := False;
3685
3686   StreamPos := Stream.Position;
3687   Stream.Read(Header[0], SizeOf(Header));
3688   Stream.Position := StreamPos;
3689
3690   {Test if the header matches}
3691   if Header = PngHeader then begin
3692     Png := TPNGObject.Create;
3693     try
3694       Png.LoadFromStream(Stream);
3695
3696       case Png.Header.ColorType of
3697         COLOR_GRAYSCALE:
3698           Format := ifLuminance;
3699         COLOR_GRAYSCALEALPHA:
3700           Format := ifLuminanceAlpha;
3701         COLOR_RGB:
3702           Format := ifBGR8;
3703         COLOR_RGBALPHA:
3704           Format := ifBGRA8;
3705         else
3706           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
3707       end;
3708
3709       PixSize := Trunc(FormatGetSize(Format));
3710       LineSize := Integer(Png.Header.Width) * PixSize;
3711
3712       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
3713       try
3714         pDest := NewImage;
3715
3716         case Png.Header.ColorType of
3717           COLOR_RGB, COLOR_GRAYSCALE:
3718             begin
3719               for Row := 0 to Png.Height -1 do begin
3720                 Move (Png.Scanline[Row]^, pDest^, LineSize);
3721                 Inc(pDest, LineSize);
3722               end;
3723             end;
3724           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
3725             begin
3726               PixSize := PixSize -1;
3727
3728               for Row := 0 to Png.Height -1 do begin
3729                 pSource := Png.Scanline[Row];
3730                 pAlpha := pByte(Png.AlphaScanline[Row]);
3731
3732                 for Col := 0 to Png.Width -1 do begin
3733                   Move (pSource^, pDest^, PixSize);
3734                   Inc(pSource, PixSize);
3735                   Inc(pDest, PixSize);
3736
3737                   pDest^ := pAlpha^;
3738                   inc(pAlpha);
3739                   Inc(pDest);
3740                 end;
3741               end;
3742             end;
3743           else
3744             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
3745         end;
3746
3747         SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
3748
3749         Result := True;
3750       except
3751         FreeMem(NewImage);
3752         raise;
3753       end;
3754     finally
3755       Png.Free;
3756     end;
3757   end;
3758 end;
3759 {$ENDIF}
3760 {$ENDIF}
3761
3762
3763 {$IFDEF GLB_LIB_JPEG}
3764 type
3765   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
3766   glBitmap_libJPEG_source_mgr = record
3767     pub: jpeg_source_mgr;
3768
3769     SrcStream: TStream;
3770     SrcBuffer: array [1..4096] of byte;
3771   end;
3772
3773
3774   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
3775   glBitmap_libJPEG_dest_mgr = record
3776     pub: jpeg_destination_mgr;
3777
3778     DestStream: TStream;
3779     DestBuffer: array [1..4096] of byte;
3780   end;
3781
3782
3783
3784 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
3785 //var
3786 //  Msg: String;
3787 begin
3788 //  SetLength(Msg, 256);
3789 //  cinfo^.err^.format_message(cinfo, pChar(Msg));
3790
3791 //  Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
3792
3793 //  cinfo^.global_state := 0;
3794
3795 //  jpeg_abort(cinfo);
3796 end;
3797
3798
3799 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
3800 //var
3801 //  Msg: String;
3802 begin
3803 //  SetLength(Msg, 256);
3804 //  cinfo^.err^.format_message(cinfo, pChar(Msg));
3805
3806 //  Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
3807
3808 //  cinfo^.global_state := 0;
3809 end;
3810
3811
3812 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
3813 begin
3814 end;
3815
3816
3817 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
3818 var
3819   src: glBitmap_libJPEG_source_mgr_ptr;
3820   bytes: integer;
3821 begin
3822   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
3823
3824   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
3825         if (bytes <= 0) then begin
3826                 src^.SrcBuffer[1] := $FF;
3827                 src^.SrcBuffer[2] := JPEG_EOI;
3828                 bytes := 2;
3829         end;
3830
3831         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
3832         src^.pub.bytes_in_buffer := bytes;
3833
3834   result := true;
3835 end;
3836
3837
3838 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
3839 var
3840   src: glBitmap_libJPEG_source_mgr_ptr;
3841 begin
3842   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
3843
3844   if num_bytes > 0 then begin
3845     // wanted byte isn't in buffer so set stream position and read buffer
3846     if num_bytes > src^.pub.bytes_in_buffer then begin
3847       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
3848       src^.pub.fill_input_buffer(cinfo);
3849     end else begin
3850       // wanted byte is in buffer so only skip
3851                 inc(src^.pub.next_input_byte, num_bytes);
3852                 dec(src^.pub.bytes_in_buffer, num_bytes);
3853     end;
3854   end;
3855 end;
3856
3857
3858 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
3859 begin
3860 end;
3861
3862
3863 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
3864 begin
3865 end;
3866
3867
3868 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
3869 var
3870   dest: glBitmap_libJPEG_dest_mgr_ptr;
3871 begin
3872   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
3873
3874   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
3875     // write complete buffer
3876     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
3877
3878     // reset buffer
3879     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
3880     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
3881   end;
3882
3883   Result := True;
3884 end;
3885
3886
3887 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
3888 var
3889   Idx: Integer;
3890   dest: glBitmap_libJPEG_dest_mgr_ptr;
3891 begin
3892   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
3893
3894   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
3895     // check for endblock
3896     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
3897       // write endblock
3898       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
3899
3900       // leave
3901       Break;
3902     end else
3903       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
3904   end;
3905 end;
3906 {$ENDIF}
3907
3908
3909 {$IFDEF GLB_SUPPORT_JPEG_READ}
3910 function TglBitmap.LoadJPEG(Stream: TStream): Boolean;
3911 {$IFDEF GLB_SDL_IMAGE}
3912 var
3913   Surface: PSDL_Surface;
3914   RWops: PSDL_RWops;
3915 begin
3916   Result := False;
3917
3918   RWops := glBitmapCreateRWops(Stream);
3919   try
3920     if IMG_isJPG(RWops) > 0 then begin
3921       Surface := IMG_LoadJPG_RW(RWops);
3922       try
3923         AssignFromSurface(Surface);
3924         Result := True;
3925       finally
3926         SDL_FreeSurface(Surface);
3927       end;
3928     end;
3929   finally
3930     SDL_FreeRW(RWops);
3931   end;
3932 end;
3933 {$ENDIF}
3934 {$IFDEF GLB_LIB_JPEG}
3935 var
3936   StreamPos: Int64;
3937   Temp: array[0..1]of Byte;
3938
3939   jpeg: jpeg_decompress_struct;
3940   jpeg_err: jpeg_error_mgr;
3941
3942   IntFormat: TglBitmapInternalFormat;
3943   pImage: pByte;
3944   TempHeight, TempWidth: Integer;
3945
3946   pTemp: pByte;
3947   Row: Integer;
3948 begin
3949   Result := False;
3950
3951   if not init_libJPEG then
3952     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
3953
3954   try
3955     // reading first two bytes to test file and set cursor back to begin
3956     StreamPos := Stream.Position;
3957     Stream.Read(Temp[0], 2);
3958     Stream.Position := StreamPos;
3959
3960     // if Bitmap then read file.
3961     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
3962       FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
3963       FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
3964
3965       // error managment
3966       jpeg.err := jpeg_std_error(@jpeg_err);
3967       jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
3968       jpeg_err.output_message := glBitmap_libJPEG_output_message;
3969
3970       // decompression struct
3971       jpeg_create_decompress(@jpeg);
3972
3973       // allocation space for streaming methods
3974       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
3975
3976       // seeting up custom functions
3977       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
3978         pub.init_source       := glBitmap_libJPEG_init_source;
3979         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
3980         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
3981         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
3982         pub.term_source       := glBitmap_libJPEG_term_source;
3983
3984         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
3985         pub.next_input_byte := nil;   // until buffer loaded
3986
3987         SrcStream := Stream;
3988       end;
3989
3990       // set global decoding state
3991       jpeg.global_state := DSTATE_START;
3992
3993       // read header of jpeg
3994       jpeg_read_header(@jpeg, False);
3995
3996       // setting output parameter
3997       case jpeg.jpeg_color_space of
3998         JCS_GRAYSCALE:
3999           begin
4000             jpeg.out_color_space := JCS_GRAYSCALE;
4001             IntFormat := ifLuminance;
4002           end;
4003         else
4004           jpeg.out_color_space := JCS_RGB;
4005           IntFormat := ifRGB8;
4006       end;
4007
4008       // reading image
4009       jpeg_start_decompress(@jpeg);
4010
4011       TempHeight := jpeg.output_height;
4012       TempWidth := jpeg.output_width;
4013
4014       // creating new image
4015       GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
4016       try
4017         pTemp := pImage;
4018
4019         for Row := 0 to TempHeight -1 do begin
4020           jpeg_read_scanlines(@jpeg, @pTemp, 1);
4021           Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
4022         end;
4023
4024         // finish decompression
4025         jpeg_finish_decompress(@jpeg);
4026
4027         // destroy decompression
4028         jpeg_destroy_decompress(@jpeg);
4029
4030         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
4031
4032         Result := True;
4033       except
4034         FreeMem(pImage);
4035         raise;
4036       end;
4037     end;
4038   finally
4039     quit_libJPEG;
4040   end;
4041 end;
4042 {$ENDIF}
4043 {$IFDEF GLB_DELPHI_JPEG}
4044 var
4045   bmp: TBitmap;
4046   jpg: TJPEGImage;
4047   StreamPos: Int64;
4048   Temp: array[0..1]of Byte;
4049 begin
4050   Result := False;
4051
4052   // reading first two bytes to test file and set cursor back to begin
4053   StreamPos := Stream.Position;
4054   Stream.Read(Temp[0], 2);
4055   Stream.Position := StreamPos;
4056
4057   // if Bitmap then read file.
4058   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
4059     bmp := TBitmap.Create;
4060     try
4061       jpg := TJPEGImage.Create;
4062       try
4063         jpg.LoadFromStream(Stream);
4064         bmp.Assign(jpg);
4065         Result := AssignFromBitmap(bmp);
4066       finally
4067         jpg.Free;
4068       end;
4069     finally
4070       bmp.Free;
4071     end;
4072   end;
4073 end;
4074 {$ENDIF}
4075 {$ENDIF}
4076
4077
4078 const
4079   BMP_MAGIC          = $4D42;
4080
4081   BMP_COMP_RGB       = 0;
4082   BMP_COMP_RLE8      = 1;
4083   BMP_COMP_RLE4      = 2;
4084   BMP_COMP_BITFIELDS = 3;
4085
4086 type
4087   TBMPHeader = packed record
4088     bfType: Word;
4089     bfSize: Cardinal;
4090     bfReserved1: Word;
4091     bfReserved2: Word;
4092     bfOffBits: Cardinal;
4093   end;
4094
4095   TBMPInfo = packed record
4096     biSize: Cardinal;
4097     biWidth: Longint;
4098     biHeight: Longint;
4099     biPlanes: Word;
4100     biBitCount: Word;
4101     biCompression: Cardinal;
4102     biSizeImage: Cardinal;
4103     biXPelsPerMeter: Longint;
4104     biYPelsPerMeter: Longint;
4105     biClrUsed: Cardinal;
4106     biClrImportant: Cardinal;
4107   end;
4108
4109   TBMPInfoOS = packed record
4110     biSize: Cardinal;
4111     biWidth: Longint;
4112     biHeight: Longint;
4113     biPlanes: Word;
4114     biBitCount: Word;
4115   end;
4116
4117 //  TBMPPalette = record
4118 //    case Boolean of
4119 //      True : (Colors: array[Byte] of TRGBQUAD);
4120 //      False: (redMask, greenMask, blueMask: Cardinal);
4121 //  end;
4122
4123 function TglBitmap.LoadBMP(Stream: TStream): Boolean;
4124 var
4125   StreamPos: Int64;
4126   Header: TBMPHeader;
4127   Info: TBMPInfo;
4128   NewImage, pData: pByte;
4129
4130   Format: TglBitmapFormat;
4131   LineSize, Padding, LineIdx: Integer;
4132   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
4133
4134   PaddingBuff: Cardinal;
4135
4136
4137   function GetLineWidth : Integer;
4138   begin
4139     Result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
4140   end;
4141
4142
4143 begin
4144   Result := False;
4145
4146   RedMask := 0;
4147   GreenMask := 0;
4148   BlueMask := 0;
4149   Format := ifEmpty;
4150
4151   // Header
4152   StreamPos := Stream.Position;
4153   Stream.Read(Header, SizeOf(Header));
4154
4155   if Header.bfType = BMP_MAGIC then begin
4156     Stream.Read(Info, SizeOf(Info));
4157
4158     // Check for Compression
4159     if Info.biCompression <> BMP_COMP_RGB then begin
4160       if Info.biCompression = BMP_COMP_BITFIELDS then begin
4161         // Read Bitmasks for 16 or 32 Bit (24 Bit dosn't support Bitmasks!)
4162         if (Info.biBitCount = 16) or (Info.biBitCount = 32) then begin
4163           Stream.Read(RedMask,   SizeOf(Cardinal));
4164           Stream.Read(GreenMask, SizeOf(Cardinal));
4165           Stream.Read(BlueMask,  SizeOf(Cardinal));
4166           Stream.Read(AlphaMask, SizeOf(Cardinal));
4167         end;
4168       end else begin
4169         // RLE compression is unsupported
4170         Stream.Position := StreamPos;
4171
4172         Exit;
4173       end;
4174     end;
4175
4176     // Skip palette
4177     if Info.biBitCount < 16 then
4178       Stream.Position := Stream.Position + Info.biClrUsed * 4;
4179
4180     // Jump to the data
4181     Stream.Position := StreamPos + Header.bfOffBits;
4182
4183     // Select Format
4184     case Info.biBitCount of
4185       8 : Format := ifLuminance;
4186       16:
4187         begin
4188           if (RedMask = 0) and (GreenMask = 0) and (BlueMask = 0) then begin
4189               Format := tfRGB5A1;
4190           end else begin
4191             if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, ifLuminanceAlpha) then
4192               Format := ifLuminanceAlpha;
4193
4194             if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, tfRGBA4) then
4195               Format := tfRGBA4;
4196
4197             if FormatCheckFormat(RedMask, GreenMask, BlueMask, 0, tfRGB5A1) then
4198               Format := tfRGB5A1;
4199
4200             if FormatCheckFormat(RedMask, GreenMask, BlueMask, 0, ifR5G6B5) then
4201               Format := ifR5G6B5;
4202           end;
4203         end;
4204       24: Format := ifBGR8;
4205       32:
4206         begin
4207           if (RedMask = 0) and (GreenMask = 0) and (BlueMask = 0) then begin
4208             Format := ifBGRA8;
4209           end else begin
4210             if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, tfRGBA8) then
4211               Format := tfRGBA8;
4212
4213             if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, ifBGRA8) then
4214               Format := ifBGRA8;
4215
4216             if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, tfRGB10A2) then
4217               Format := tfRGB10A2;
4218           end;
4219         end;
4220     end;
4221
4222     if Format <> ifEmpty then begin
4223        LineSize := Trunc(Info.biWidth * FormatGetSize(Format));
4224       Padding := GetLineWidth - LineSize;
4225
4226       // copying data
4227       GetMem(NewImage, Info.biHeight * LineSize);
4228       try
4229         FillChar(NewImage^, Info.biHeight * LineSize, $FF);
4230
4231         // Set pData to last Line
4232         pData := NewImage;
4233         Inc(pData, LineSize * (Info.biHeight -1));
4234
4235         // Copy Image Data
4236         for LineIdx := 0 to Info.biHeight - 1 do begin
4237           Stream.Read(pData^, LineSize);
4238           Dec(pData, LineSize);
4239
4240           Stream.Read(PaddingBuff, Padding);
4241         end;
4242
4243         // Set new Image
4244         SetDataPointer(NewImage, Format, Info.biWidth, Info.biHeight);
4245
4246         Result := True;
4247       except
4248         FreeMem(NewImage);
4249         raise;
4250       end;
4251     end;
4252   end
4253     else Stream.Position := StreamPos;
4254 end;
4255 {$ENDREGION}
4256
4257 const
4258   DDS_MAGIC                   = $20534444;
4259
4260   // DDS_header.dwFlags
4261   DDSD_CAPS                   = $00000001;
4262   DDSD_HEIGHT                 = $00000002;
4263   DDSD_WIDTH                  = $00000004;
4264   DDSD_PITCH                  = $00000008;
4265   DDSD_PIXELFORMAT            = $00001000;
4266   DDSD_MIPMAPCOUNT            = $00020000;
4267   DDSD_LINEARSIZE             = $00080000;
4268   DDSD_DEPTH                  = $00800000;
4269
4270   // DDS_header.sPixelFormat.dwFlags
4271   DDPF_ALPHAPIXELS            = $00000001;
4272   DDPF_FOURCC                 = $00000004;
4273   DDPF_INDEXED                = $00000020;
4274   DDPF_RGB                    = $00000040;
4275
4276   // DDS_header.sCaps.dwCaps1
4277   DDSCAPS_COMPLEX             = $00000008;
4278   DDSCAPS_TEXTURE             = $00001000;
4279   DDSCAPS_MIPMAP              = $00400000;
4280
4281   // DDS_header.sCaps.dwCaps2
4282   DDSCAPS2_CUBEMAP            = $00000200;
4283   DDSCAPS2_CUBEMAP_POSITIVEX  = $00000400;
4284   DDSCAPS2_CUBEMAP_NEGATIVEX  = $00000800;
4285   DDSCAPS2_CUBEMAP_POSITIVEY  = $00001000;
4286   DDSCAPS2_CUBEMAP_NEGATIVEY  = $00002000;
4287   DDSCAPS2_CUBEMAP_POSITIVEZ  = $00004000;
4288   DDSCAPS2_CUBEMAP_NEGATIVEZ  = $00008000;
4289   DDSCAPS2_VOLUME             = $00200000;
4290
4291   D3DFMT_DXT1                 = $31545844;
4292   D3DFMT_DXT3                 = $33545844;
4293   D3DFMT_DXT5                 = $35545844;
4294
4295 type
4296   TDDSPixelFormat = packed record
4297     dwSize: Cardinal;
4298     dwFlags: Cardinal;
4299     dwFourCC: Cardinal;
4300     dwRGBBitCount: Cardinal;
4301     dwRBitMask: Cardinal;
4302     dwGBitMask: Cardinal;
4303     dwBBitMask: Cardinal;
4304     dwAlphaBitMask: Cardinal;
4305   end;
4306
4307   TDDSCaps = packed record
4308     dwCaps1: Cardinal;
4309     dwCaps2: Cardinal;
4310     dwDDSX: Cardinal;
4311     dwReserved: Cardinal;
4312   end;
4313
4314   TDDSHeader = packed record
4315     dwMagic: Cardinal;
4316     dwSize: Cardinal;
4317     dwFlags: Cardinal;
4318     dwHeight: Cardinal;
4319     dwWidth: Cardinal;
4320     dwPitchOrLinearSize: Cardinal;
4321     dwDepth: Cardinal;
4322     dwMipMapCount: Cardinal;
4323     dwReserved: array[0..10] of Cardinal;
4324     PixelFormat: TDDSPixelFormat;
4325     Caps: TDDSCaps;
4326     dwReserved2: Cardinal;
4327   end;
4328
4329
4330
4331 function TglBitmap.LoadDDS(Stream: TStream): Boolean;
4332 var
4333   Header: TDDSHeader;
4334   StreamPos: Int64;
4335   Y, LineSize: Cardinal;
4336
4337 //  MipMapCount, X, Y, XSize, YSize: Cardinal;
4338   RowSize: Cardinal;
4339   NewImage, pData: pByte;
4340   Format: TglBitmapFormat;
4341
4342
4343   function RaiseEx : Exception;
4344   begin
4345     Result := EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
4346   end;
4347
4348
4349   function GetInternalFormat: TglBitmapFormat;
4350   begin
4351     with Header.PixelFormat do begin
4352       // Compresses
4353       if (dwFlags and DDPF_FOURCC) > 0 then begin
4354         case Header.PixelFormat.dwFourCC of
4355           D3DFMT_DXT1: Result := ifDXT1;
4356           D3DFMT_DXT3: Result := ifDXT3;
4357           D3DFMT_DXT5: Result := ifDXT5;
4358           else
4359             raise RaiseEx;
4360         end;
4361       end else
4362
4363       // RGB
4364       if (dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
4365         case dwRGBBitCount of
4366            8:
4367             begin
4368               if dwFlags and DDPF_ALPHAPIXELS > 0 then
4369                 Result := ifAlpha
4370               else
4371                 Result := ifLuminance;
4372             end;
4373           16:
4374             begin
4375               if dwFlags and DDPF_ALPHAPIXELS > 0 then begin
4376                 // Alpha
4377                 case GetBitSize(dwRBitMask) of
4378                   5: Result := tfRGB5A1;
4379                   4: Result := tfRGBA4;
4380                 else
4381                   Result := ifLuminanceAlpha;
4382                 end;
4383               end else begin
4384                 // no Alpha
4385                 Result := ifR5G6B5;
4386               end;
4387             end;
4388           24:
4389             begin
4390               if dwRBitMask > dwBBitMask then
4391                 Result := ifBGR8
4392               else
4393                 Result := tfRGB8;
4394             end;
4395           32:
4396             begin
4397               if GetBitSize(dwRBitMask) = 10 then
4398                 Result := tfRGB10A2
4399               else
4400
4401               if dwRBitMask > dwBBitMask then
4402                 Result := ifBGRA8
4403               else
4404                 Result := tfRGBA8;
4405             end;
4406           else
4407             raise RaiseEx;
4408         end;
4409       end else
4410         raise RaiseEx;
4411     end;
4412   end;
4413
4414 begin
4415   Result := False;
4416
4417   // Header
4418   StreamPos := Stream.Position;
4419   Stream.Read(Header, sizeof(Header));
4420
4421   if ((Header.dwMagic <> DDS_MAGIC) or (Header.dwSize <> 124) or
4422      ((Header.dwFlags and DDSD_PIXELFORMAT) = 0) or ((Header.dwFlags and DDSD_CAPS) = 0)) then begin
4423     Stream.Position := StreamPos;
4424     Exit;
4425   end;
4426
4427   // Pixelformat
4428 //  if Header.dwFlags and DDSD_MIPMAPCOUNT <> 0
4429 //    then MipMapCount := Header.dwMipMapCount
4430 //    else MipMapCount := 1;
4431
4432   Format := GetInternalFormat;
4433   LineSize := Trunc(Header.dwWidth * FormatGetSize(Format));
4434
4435   GetMem(NewImage, Header.dwHeight * LineSize);
4436   try
4437     pData := NewImage;
4438
4439     // Compressed
4440     if (Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0 then begin
4441       RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
4442
4443       for Y := 0 to Header.dwHeight -1 do begin
4444         Stream.Read(pData^, RowSize);
4445         Inc(pData, LineSize);
4446       end;
4447     end else
4448
4449     // RGB(A)
4450     if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
4451       RowSize := Header.dwPitchOrLinearSize;
4452
4453       for Y := 0 to Header.dwHeight -1 do begin
4454         Stream.Read(pData^, RowSize);
4455         Inc(pData, LineSize);
4456       end;
4457     end
4458       else raise RaiseEx;
4459
4460     SetDataPointer(NewImage, Format, Header.dwWidth, Header.dwHeight);
4461
4462     Result := True;
4463   except
4464     FreeMem(NewImage);
4465     raise;
4466   end;
4467 end;
4468
4469
4470 type
4471   TTGAHeader = packed record
4472     ImageID: Byte;
4473     ColorMapType: Byte;
4474     ImageType: Byte;
4475     ColorMapSpec: Array[0..4] of Byte;
4476     OrigX: Word;
4477     OrigY: Word;
4478     Width: Word;
4479     Height: Word;
4480     Bpp: Byte;
4481     ImageDes: Byte;
4482   end;
4483
4484 const
4485   TGA_UNCOMPRESSED_RGB = 2;
4486   TGA_UNCOMPRESSED_GRAY = 3;
4487   TGA_COMPRESSED_RGB = 10;
4488   TGA_COMPRESSED_GRAY = 11;
4489
4490
4491
4492 function TglBitmap.LoadTGA(Stream: TStream): Boolean;
4493 var
4494   Header: TTGAHeader;
4495   NewImage, pData: PByte;
4496   StreamPos: Int64;
4497   PixelSize, LineSize, YStart, YEnd, YInc: Integer;
4498   Format: TglBitmapFormat;
4499
4500 const
4501   CACHE_SIZE = $4000;
4502
4503   procedure ReadUncompressed;
4504   var
4505     RowSize: Integer;
4506   begin
4507     RowSize := Header.Width * PixelSize;
4508
4509     // copy line by line
4510     while YStart <> YEnd + YInc do begin
4511       pData := NewImage;
4512       Inc(pData, YStart * LineSize);
4513
4514       Stream.Read(pData^, RowSize);
4515       Inc(YStart, YInc);
4516     end;
4517   end;
4518
4519
4520   procedure ReadCompressed;
4521   var
4522     HeaderWidth, HeaderHeight: Integer;
4523     LinePixelsRead, ImgPixelsRead, ImgPixelsToRead: Integer;
4524
4525     Cache: PByte;
4526     CacheSize, CachePos: Integer;
4527
4528     Temp: Byte;
4529     TempBuf: Array [0..15] of Byte;
4530
4531     PixelRepeat: Boolean;
4532     PixelToRead, TempPixels: Integer;
4533
4534
4535     procedure CheckLine;
4536     begin
4537       if LinePixelsRead >= HeaderWidth then begin
4538         LinePixelsRead := 0;
4539         pData := NewImage;
4540         Inc(YStart, YInc);
4541         Inc(pData, YStart * LineSize);
4542       end;
4543     end;
4544
4545
4546     procedure CachedRead(var Buffer; Count: Integer);
4547     var
4548       BytesRead: Integer;
4549     begin
4550       if (CachePos + Count) > CacheSize then begin
4551         BytesRead := 0;
4552
4553         // Read Data
4554         if CacheSize - CachePos > 0 then begin
4555           BytesRead := CacheSize - CachePos;
4556
4557           Move(pByteArray(Cache)^[CachePos], Buffer, BytesRead);
4558           Inc(CachePos, BytesRead);
4559         end;
4560
4561         // Reload Data
4562         CacheSize := Min(CACHE_SIZE, Stream.Size - Stream.Position);
4563         Stream.Read(Cache^, CacheSize);
4564         CachePos := 0;
4565
4566         // Read else
4567         if Count - BytesRead > 0 then begin
4568           Move(pByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
4569           Inc(CachePos, Count - BytesRead);
4570         end;
4571       end else begin
4572         Move(pByteArray(Cache)^[CachePos], Buffer, Count);
4573         Inc(CachePos, Count);
4574       end;
4575     end;
4576
4577
4578   begin
4579     CacheSize := 0;
4580     CachePos := 0;
4581
4582     HeaderWidth := Header.Width;
4583     HeaderHeight := Header.Height;
4584
4585     GetMem(Cache, CACHE_SIZE); // 16K Buffer
4586     try
4587       ImgPixelsToRead := HeaderWidth * HeaderHeight;
4588       ImgPixelsRead := 0;
4589       LinePixelsRead := 0;
4590
4591       pData := NewImage;
4592       Inc(pData, YStart * LineSize);
4593
4594       // Read until all Pixels
4595       repeat
4596         CachedRead(Temp, 1);
4597
4598         PixelRepeat := Temp and $80 > 0;
4599         PixelToRead := (Temp and $7F) + 1;
4600
4601         Inc(ImgPixelsRead, PixelToRead);
4602
4603         if PixelRepeat then begin
4604           // repeat one pixel x times
4605           CachedRead(TempBuf[0], PixelSize);
4606
4607           // repeat Pixel
4608           while PixelToRead > 0 do begin
4609             CheckLine;
4610
4611             TempPixels := HeaderWidth - LinePixelsRead;
4612             if PixelToRead < TempPixels then
4613               TempPixels := PixelToRead;
4614
4615             Inc(LinePixelsRead, TempPixels);
4616             Dec(PixelToRead, TempPixels);
4617
4618             while TempPixels > 0 do begin
4619               case PixelSize of
4620                 1:
4621                   begin
4622                     pData^ := TempBuf[0];
4623                     Inc(pData);
4624                   end;
4625                 2:
4626                   begin
4627                     pWord(pData)^ := pWord(@TempBuf[0])^;
4628                     Inc(pData, 2);
4629                   end;
4630                 3:
4631                   begin
4632                     pWord(pData)^ := pWord(@TempBuf[0])^;
4633                     Inc(pData, 2);
4634                     pData^ := TempBuf[2];
4635                     Inc(pData);
4636                   end;
4637                 4:
4638                   begin
4639                     pDWord(pData)^ := pDWord(@TempBuf[0])^;
4640                     Inc(pData, 4);
4641                   end;
4642               end;
4643
4644               Dec(TempPixels);
4645             end;
4646           end;
4647         end else begin
4648           // copy x pixels
4649           while PixelToRead > 0 do begin
4650             CheckLine;
4651
4652             TempPixels := HeaderWidth - LinePixelsRead;
4653             if PixelToRead < TempPixels then
4654               TempPixels := PixelToRead;
4655
4656             CachedRead(pData^, PixelSize * TempPixels);
4657             Inc(pData, PixelSize * TempPixels);
4658
4659             Inc(LinePixelsRead, TempPixels);
4660
4661             Dec(PixelToRead, TempPixels);
4662           end;
4663         end;
4664       until ImgPixelsRead >= ImgPixelsToRead;
4665     finally
4666       FreeMem(Cache)
4667     end;
4668   end;
4669
4670 begin
4671   Result := False;
4672
4673   // reading header to test file and set cursor back to begin
4674   StreamPos := Stream.Position;
4675   Stream.Read(Header, SizeOf(Header));
4676
4677   // no colormapped files
4678   if (Header.ColorMapType = 0) then begin
4679     if Header.ImageType in [TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY] then begin
4680       case Header.Bpp of
4681          8: Format := ifAlpha;
4682         16: Format := ifLuminanceAlpha;
4683         24: Format := ifBGR8;
4684         32: Format := ifBGRA8;
4685         else
4686           raise EglBitmapException.Create('LoadTga - unsupported BitsPerPixel found.');
4687       end;
4688
4689       // skip image ID
4690       if Header.ImageID <> 0 then
4691         Stream.Position := Stream.Position + Header.ImageID;
4692
4693       PixelSize := Trunc(FormatGetSize(Format));
4694       LineSize := Trunc(Header.Width * PixelSize);
4695
4696       GetMem(NewImage, LineSize * Header.Height);
4697       try
4698         // Row direction
4699         if (Header.ImageDes and $20 > 0) then begin
4700           YStart := 0;
4701           YEnd := Header.Height -1;
4702           YInc := 1;
4703         end else begin
4704           YStart := Header.Height -1;
4705           YEnd := 0;
4706           YInc := -1;
4707         end;
4708
4709         // Read Image
4710         case Header.ImageType of
4711           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
4712             ReadUncompressed;
4713           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
4714             ReadCompressed;
4715         end;
4716
4717         SetDataPointer(NewImage, Format, Header.Width, Header.Height);
4718
4719         Result := True;
4720       except
4721         FreeMem(NewImage);
4722         raise;
4723       end;
4724     end
4725       else Stream.Position := StreamPos;
4726   end
4727     else Stream.Position := StreamPos;
4728 end;
4729
4730
4731 {$IFDEF GLB_SUPPORT_PNG_WRITE}
4732 {$IFDEF GLB_LIB_PNG}
4733 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4734 begin
4735   TStream(png_get_io_ptr(png)).Write(buffer^, size);
4736 end;
4737 {$ENDIF}
4738
4739 procedure TglBitmap.SavePNG(Stream: TStream);
4740 {$IFDEF GLB_LIB_PNG}
4741 var
4742   png: png_structp;
4743   png_info: png_infop;
4744   png_rows: array of pByte;
4745   LineSize: Integer;
4746   ColorType: Integer;
4747   Row: Integer;
4748 begin
4749   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
4750     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
4751
4752   if not init_libPNG then
4753     raise Exception.Create('SavePNG - unable to initialize libPNG.');
4754
4755   try
4756     case FInternalFormat of
4757       ifAlpha, ifLuminance, ifDepth8:
4758         ColorType := PNG_COLOR_TYPE_GRAY;
4759       ifLuminanceAlpha:
4760         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
4761       ifBGR8, ifRGB8:
4762         ColorType := PNG_COLOR_TYPE_RGB;
4763       ifBGRA8, ifRGBA8:
4764         ColorType := PNG_COLOR_TYPE_RGBA;
4765       else
4766         raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
4767     end;
4768
4769     LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
4770
4771     // creating array for scanline
4772     SetLength(png_rows, Height);
4773     try
4774       for Row := 0 to Height - 1 do begin
4775         png_rows[Row] := Data;
4776         Inc(png_rows[Row], Row * LineSize)
4777       end;
4778
4779       // write struct
4780       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4781       if png = nil then
4782         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
4783
4784       // create png info
4785       png_info := png_create_info_struct(png);
4786       if png_info = nil then begin
4787         png_destroy_write_struct(@png, nil);
4788         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
4789       end;
4790
4791       // set read callback
4792       png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
4793
4794       // set compression
4795       png_set_compression_level(png, 6);
4796
4797       if InternalFormat in [ifBGR8, ifBGRA8] then
4798         png_set_bgr(png);
4799
4800       // setup header
4801       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
4802
4803       // write info
4804       png_write_info(png, png_info);
4805
4806       // write image data
4807       png_write_image(png, @png_rows[0]);
4808
4809       // write end
4810       png_write_end(png, png_info);
4811
4812       // destroy write struct
4813       png_destroy_write_struct(@png, @png_info);
4814     finally
4815       SetLength(png_rows, 0);
4816     end;
4817   finally
4818     quit_libPNG;
4819   end;
4820 end;
4821 {$ENDIF}
4822 {$IFDEF GLB_PNGIMAGE}
4823 var
4824   Png: TPNGObject;
4825
4826   pSource, pDest: pByte;
4827   X, Y, PixSize: Integer;
4828   ColorType: Cardinal;
4829   Alpha: Boolean;
4830
4831   pTemp: pByte;
4832   Temp: Byte;
4833 begin
4834   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
4835     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
4836
4837   case FInternalFormat of
4838     ifAlpha, ifLuminance, ifDepth8:
4839       begin
4840         ColorType := COLOR_GRAYSCALE;
4841         PixSize := 1;
4842         Alpha := False;
4843       end;
4844     ifLuminanceAlpha:
4845       begin
4846         ColorType := COLOR_GRAYSCALEALPHA;
4847         PixSize := 1;
4848         Alpha := True;
4849       end;
4850     ifBGR8, ifRGB8:
4851       begin
4852         ColorType := COLOR_RGB;
4853         PixSize := 3;
4854         Alpha := False;
4855       end;
4856     ifBGRA8, ifRGBA8:
4857       begin
4858         ColorType := COLOR_RGBALPHA;
4859         PixSize := 3;
4860         Alpha := True
4861       end;
4862     else
4863       raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
4864   end;
4865
4866   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
4867   try
4868     // Copy ImageData
4869     pSource := Data;
4870     for Y := 0 to Height -1 do begin
4871       pDest := png.ScanLine[Y];
4872
4873       for X := 0 to Width -1 do begin
4874         Move(pSource^, pDest^, PixSize);
4875
4876         Inc(pDest, PixSize);
4877         Inc(pSource, PixSize);
4878
4879         if Alpha then begin
4880           png.AlphaScanline[Y]^[X] := pSource^;
4881           Inc(pSource);
4882         end;
4883       end;
4884
4885       // convert RGB line to BGR
4886       if InternalFormat in [ifRGB8, ifRGBA8] then begin
4887         pTemp := png.ScanLine[Y];
4888
4889         for X := 0 to Width -1 do begin
4890           Temp := pByteArray(pTemp)^[0];
4891           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
4892           pByteArray(pTemp)^[2] := Temp;
4893
4894           Inc(pTemp, 3);
4895         end;
4896       end;
4897     end;
4898
4899     // Save to Stream
4900     Png.CompressionLevel := 6;
4901     Png.SaveToStream(Stream);
4902   finally
4903     FreeAndNil(Png);
4904   end;
4905 end;
4906 {$ENDIF}
4907 {$ENDIF}
4908
4909
4910 procedure TglBitmap.SaveDDS(Stream: TStream);
4911 var
4912   Header: TDDSHeader;
4913   Pix: TglBitmapPixelData;
4914 begin
4915   if not FormatIsUncompressed(InternalFormat) then
4916     raise EglBitmapUnsupportedFormatFormat.Create('SaveDDS - ' + UNSUPPORTED_INTERNAL_FORMAT);
4917
4918   if InternalFormat = ifAlpha then
4919     FormatPreparePixel(Pix, ifLuminance)
4920   else
4921     FormatPreparePixel(Pix, InternalFormat);
4922
4923   // Generell
4924   FillChar(Header, SizeOf(Header), 0);
4925
4926   Header.dwMagic := DDS_MAGIC;
4927   Header.dwSize := 124;
4928   Header.dwFlags := DDSD_PITCH or DDSD_CAPS or DDSD_PIXELFORMAT;
4929
4930   if Width > 0 then begin
4931     Header.dwWidth := Width;
4932     Header.dwFlags := Header.dwFlags or DDSD_WIDTH;
4933   end;
4934
4935   if Height > 0 then begin
4936     Header.dwHeight := Height;
4937     Header.dwFlags := Header.dwFlags or DDSD_HEIGHT;
4938   end;
4939
4940   Header.dwPitchOrLinearSize := fRowSize;
4941   Header.dwMipMapCount := 1;
4942
4943   // Caps
4944   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
4945
4946   // Pixelformat
4947   Header.PixelFormat.dwSize := Sizeof(Header.PixelFormat);
4948   Header.PixelFormat.dwFlags := DDPF_RGB;
4949
4950   if FormatHasAlpha(InternalFormat) and (InternalFormat <> ifAlpha)
4951     then Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
4952
4953   Header.PixelFormat.dwRGBBitCount  := Trunc(FormatGetSize(InternalFormat) * 8);
4954   Header.PixelFormat.dwRBitMask     := Pix.PixelDesc.RedRange   shl Pix.PixelDesc.RedShift;
4955   Header.PixelFormat.dwGBitMask     := Pix.PixelDesc.GreenRange shl Pix.PixelDesc.GreenShift;
4956   Header.PixelFormat.dwBBitMask     := Pix.PixelDesc.BlueRange  shl Pix.PixelDesc.BlueShift;
4957   Header.PixelFormat.dwAlphaBitMask := Pix.PixelDesc.AlphaRange shl Pix.PixelDesc.AlphaShift;
4958
4959   // Write
4960   Stream.Write(Header, SizeOf(Header));
4961
4962   Stream.Write(Data^, FormatGetImageSize(glBitmapPosition(Width, Height), InternalFormat));
4963 end;
4964
4965
4966 procedure TglBitmap.SaveTGA(Stream: TStream);
4967 var
4968   Header: TTGAHeader;
4969   Size: Integer;
4970   pTemp: pByte;
4971
4972
4973   procedure ConvertData(pTemp: pByte);
4974   var
4975     Idx, PixelSize: Integer;
4976     Temp: byte;
4977   begin
4978     PixelSize := fPixelSize;
4979
4980     for Idx := 1 to Height * Width do begin
4981       Temp := pByteArray(pTemp)^[2];
4982       pByteArray(pTemp)^[2] := pByteArray(pTemp)^[0];
4983       pByteArray(pTemp)^[0] := Temp;
4984
4985       Inc(pTemp, PixelSize);
4986     end;
4987   end;
4988
4989
4990 begin
4991   if not (ftTGA in FormatGetSupportedFiles (InternalFormat)) then
4992     raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_INTERNAL_FORMAT);
4993
4994   FillChar(Header, SizeOf(Header), 0);
4995
4996   case InternalFormat of
4997     ifAlpha, ifLuminance, ifDepth8:
4998       begin
4999         Header.ImageType := TGA_UNCOMPRESSED_GRAY;
5000         Header.Bpp := 8;
5001       end;
5002     ifLuminanceAlpha:
5003       begin
5004         Header.ImageType := TGA_UNCOMPRESSED_GRAY;
5005         Header.Bpp := 16;
5006       end;
5007     tfRGB8, ifBGR8:
5008       begin
5009         Header.ImageType := TGA_UNCOMPRESSED_RGB;
5010         Header.Bpp := 24;
5011       end;
5012     tfRGBA8, ifBGRA8:
5013       begin
5014         Header.ImageType := TGA_UNCOMPRESSED_RGB;
5015         Header.Bpp := 32;
5016       end;
5017     else
5018       raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_INTERNAL_FORMAT);
5019   end;
5020
5021   Header.Width := Width;
5022   Header.Height := Height;
5023   Header.ImageDes := $20;
5024
5025   if FormatHasAlpha(InternalFormat) then
5026     Header.ImageDes := Header.ImageDes or $08;
5027
5028   Stream.Write(Header, SizeOf(Header));
5029
5030   // convert RGB(A) to BGR(A)
5031   Size := FormatGetImageSize(glBitmapPosition(Width, Height), InternalFormat);
5032   if InternalFormat in [tfRGB8, tfRGBA8] then begin
5033     GetMem(pTemp, Size);
5034   end else
5035     pTemp := Data;
5036
5037   try
5038     // convert data
5039     if InternalFormat in [tfRGB8, tfRGBA8] then begin
5040       Move(Data^, pTemp^, Size);
5041       ConvertData(pTemp);
5042     end;
5043
5044     // write data
5045     Stream.Write(pTemp^, Size);
5046   finally
5047     // free tempdata
5048     if InternalFormat in [tfRGB8, tfRGBA8] then
5049       FreeMem(pTemp);
5050   end;
5051 end;
5052
5053
5054 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5055 procedure TglBitmap.SaveJPEG(Stream: TStream);
5056 {$IFDEF GLB_LIB_JPEG}
5057 var
5058   jpeg: jpeg_compress_struct;
5059   jpeg_err: jpeg_error_mgr;
5060   Row: Integer;
5061   pTemp, pTemp2: pByte;
5062
5063
5064   procedure CopyRow(pDest, pSource: pByte);
5065   var
5066     X: Integer;
5067   begin
5068     for X := 0 to Width - 1 do begin
5069       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
5070       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
5071       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
5072
5073       Inc(pDest, 3);
5074       Inc(pSource, 3);
5075     end;
5076   end;
5077
5078 begin
5079   if not (ftJPEG in FormatGetSupportedFiles(InternalFormat)) then
5080     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
5081
5082   if not init_libJPEG then
5083     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
5084
5085   try
5086     FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
5087     FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
5088
5089     // error managment
5090     jpeg.err := jpeg_std_error(@jpeg_err);
5091     jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
5092     jpeg_err.output_message := glBitmap_libJPEG_output_message;
5093
5094     // compression struct
5095     jpeg_create_compress(@jpeg);
5096
5097     // allocation space for streaming methods
5098     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
5099
5100     // seeting up custom functions
5101     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
5102       pub.init_destination    := glBitmap_libJPEG_init_destination;
5103       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
5104       pub.term_destination    := glBitmap_libJPEG_term_destination;
5105
5106       pub.next_output_byte  := @DestBuffer[1];
5107       pub.free_in_buffer    := Length(DestBuffer);
5108
5109       DestStream := Stream;
5110     end;
5111
5112     // very important state
5113     jpeg.global_state := CSTATE_START;
5114
5115     jpeg.image_width := Width;
5116     jpeg.image_height := Height;
5117     case InternalFormat of
5118       ifAlpha, ifLuminance, ifDepth8:
5119         begin
5120           jpeg.input_components := 1;
5121           jpeg.in_color_space := JCS_GRAYSCALE;
5122         end;
5123       ifRGB8, ifBGR8:
5124         begin
5125           jpeg.input_components := 3;
5126           jpeg.in_color_space := JCS_RGB;
5127         end;
5128     end;
5129
5130     // setting defaults
5131     jpeg_set_defaults(@jpeg);
5132
5133     // compression quality
5134     jpeg_set_quality(@jpeg, 95, True);
5135
5136     // start compression
5137     jpeg_start_compress(@jpeg, true);
5138
5139     // write rows
5140     pTemp := Data;
5141
5142     // initialing row
5143     if InternalFormat = ifBGR8 then
5144       GetMem(pTemp2, fRowSize)
5145     else
5146       pTemp2 := pTemp;
5147
5148     try
5149       for Row := 0 to jpeg.image_height -1 do begin
5150         // prepare row
5151         if InternalFormat = ifBGR8 then
5152           CopyRow(pTemp2, pTemp)
5153         else
5154           pTemp2 := pTemp;
5155
5156         // write row
5157         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
5158         inc(pTemp, fRowSize);
5159       end;
5160     finally
5161       // free memory
5162       if InternalFormat = ifBGR8 then
5163         FreeMem(pTemp2);
5164     end;
5165
5166     // finish compression
5167     jpeg_finish_compress(@jpeg);
5168
5169     // destroy compression
5170     jpeg_destroy_compress(@jpeg);
5171   finally
5172     quit_libJPEG;
5173   end;
5174 end;
5175 {$ENDIF}
5176 {$IFDEF GLB_DELPHI_JPEG}
5177 var
5178   Bmp: TBitmap;
5179   Jpg: TJPEGImage;
5180 begin
5181   if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
5182     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
5183
5184   Bmp := TBitmap.Create;
5185   try
5186     Jpg := TJPEGImage.Create;
5187     try
5188       AssignToBitmap(Bmp);
5189
5190       if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
5191         Jpg.Grayscale := True;
5192         Jpg.PixelFormat := jf8Bit;
5193       end;
5194
5195       Jpg.Assign(Bmp);
5196
5197       Jpg.SaveToStream(Stream);
5198     finally
5199       FreeAndNil(Jpg);
5200     end;
5201   finally
5202     FreeAndNil(Bmp);
5203   end;
5204 end;
5205 {$ENDIF}
5206 {$ENDIF}
5207
5208
5209 procedure TglBitmap.SaveBMP(Stream: TStream);
5210 var
5211   Header: TBMPHeader;
5212   Info: TBMPInfo;
5213   pData, pTemp: pByte;
5214
5215   PixelFormat: TglBitmapPixelData;
5216   ImageSize, LineSize, Padding, LineIdx, ColorIdx: Integer;
5217   Temp, RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
5218
5219   PaddingBuff: Cardinal;
5220
5221
5222   function GetLineWidth : Integer;
5223   begin
5224     Result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
5225   end;
5226
5227
5228 begin
5229   if not (ftBMP in FormatGetSupportedFiles(InternalFormat)) then
5230     raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_INTERNAL_FORMAT);
5231
5232   ImageSize := Trunc(Width * Height * FormatGetSize(InternalFormat));
5233
5234   Header.bfType := BMP_MAGIC;
5235   Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
5236   Header.bfReserved1 := 0;
5237   Header.bfReserved2 := 0;
5238   Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
5239
5240   FillChar(Info, SizeOf(Info), 0);
5241   Info.biSize := SizeOf(Info);
5242   Info.biWidth := Width;
5243   Info.biHeight := Height;
5244   Info.biPlanes := 1;
5245   Info.biCompression := BMP_COMP_RGB;
5246   Info.biSizeImage := ImageSize;
5247   case InternalFormat of
5248     ifAlpha, ifLuminance, ifDepth8:
5249       begin
5250         Info.biBitCount :=  8;
5251
5252         Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
5253         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal);
5254
5255         Info.biClrUsed := 256;
5256         Info.biClrImportant := 256;
5257       end;
5258     ifLuminanceAlpha, tfRGBA4, ifR5G6B5, tfRGB5A1:
5259       begin
5260         Info.biBitCount := 16;
5261         Info.biCompression := BMP_COMP_BITFIELDS;
5262       end;
5263     ifBGR8, tfRGB8:
5264       Info.biBitCount := 24;
5265     ifBGRA8, tfRGBA8, tfRGB10A2:
5266       begin
5267         Info.biBitCount := 32;
5268         Info.biCompression := BMP_COMP_BITFIELDS;
5269       end;
5270     else
5271       raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_INTERNAL_FORMAT);
5272   end;
5273   Info.biXPelsPerMeter := 2835;
5274   Info.biYPelsPerMeter := 2835;
5275
5276   // prepare bitmasks
5277   if Info.biCompression = BMP_COMP_BITFIELDS then begin
5278     Info.biSize := Info.biSize + 4 * SizeOf(Cardinal);
5279     Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
5280     Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
5281
5282     FormatPreparePixel(PixelFormat, InternalFormat);
5283
5284     with PixelFormat.PixelDesc do begin
5285       RedMask   := RedRange   shl RedShift;
5286       GreenMask := GreenRange shl GreenShift;
5287       BlueMask  := BlueRange  shl BlueShift;
5288       AlphaMask := AlphaRange shl AlphaShift;
5289     end;
5290   end;
5291
5292   // headers
5293   Stream.Write(Header, SizeOf(Header));
5294   Stream.Write(Info, SizeOf(Info));
5295
5296   // colortable
5297   if Info.biBitCount = 8 then begin
5298     Temp := 0;
5299     for ColorIdx := Low(Byte) to High(Byte) do begin
5300       Stream.Write(Temp, 4);
5301       Temp := Temp + $00010101;
5302     end;
5303   end;
5304
5305   // bitmasks
5306   if Info.biCompression = BMP_COMP_BITFIELDS then begin
5307     Stream.Write(RedMask, SizeOf(Cardinal));
5308     Stream.Write(GreenMask, SizeOf(Cardinal));
5309     Stream.Write(BlueMask, SizeOf(Cardinal));
5310     Stream.Write(AlphaMask, SizeOf(Cardinal));
5311   end;
5312
5313   // image data
5314   LineSize := Trunc(Width * FormatGetSize(InternalFormat));
5315   Padding := GetLineWidth - LineSize;
5316   PaddingBuff := 0;
5317
5318   pData := Data;
5319   Inc(pData, (Height -1) * LineSize);
5320
5321   // prepare row buffer. But only for RGB because RGBA supports color masks
5322   // so it's possible to change color within the image.
5323   if InternalFormat = tfRGB8 then
5324     GetMem(pTemp, fRowSize)
5325   else
5326     pTemp := nil;
5327
5328   try
5329     // write image data
5330     for LineIdx := 0 to Height - 1 do begin
5331       // preparing row
5332       if InternalFormat = tfRGB8 then begin
5333         Move(pData^, pTemp^, fRowSize);
5334         SwapRGB(pTemp, Width, False);
5335       end else
5336         pTemp := pData;
5337
5338       Stream.Write(pTemp^, LineSize);
5339
5340       Dec(pData, LineSize);
5341
5342       if Padding > 0 then
5343         Stream.Write(PaddingBuff, Padding);
5344     end;
5345   finally
5346     // destroy row buffer
5347     if InternalFormat = tfRGB8 then
5348       FreeMem(pTemp);
5349   end;
5350 end;
5351
5352
5353 procedure TglBitmap.Bind(EnableTextureUnit: Boolean);
5354 begin
5355   if EnableTextureUnit then
5356     glEnable(Target);
5357
5358   if ID > 0 then
5359     glBindTexture(Target, ID);
5360 end;
5361
5362
5363 procedure TglBitmap.Unbind(DisableTextureUnit: Boolean);
5364 begin
5365   if DisableTextureUnit then
5366     glDisable(Target);
5367
5368   glBindTexture(Target, 0);
5369 end;
5370
5371
5372 procedure TglBitmap.GetPixel(const Pos: TglBitmapPixelPosition;
5373   var Pixel: TglBitmapPixelData);
5374 begin
5375   if Assigned (fGetPixelFunc) then
5376     fGetPixelFunc(Pos, Pixel);
5377 end;
5378
5379
5380 procedure TglBitmap.SetPixel (const Pos: TglBitmapPixelPosition;
5381   const Pixel: TglBitmapPixelData);
5382 begin
5383   if Assigned (fSetPixelFunc) then
5384     fSetPixelFunc(Pos, Pixel);
5385 end;
5386
5387
5388
5389
5390
5391
5392 function TglBitmap.FlipHorz: Boolean;
5393 begin
5394   Result := False;
5395 end;
5396
5397
5398 function TglBitmap.FlipVert: Boolean;
5399 begin
5400   Result := False;
5401 end;
5402
5403
5404 procedure TglBitmap.FreeData;
5405 begin
5406   SetDataPointer(nil, ifEmpty);
5407 end;
5408
5409
5410 procedure glBitmapFillWithColorFunc(var FuncRec: TglBitmapFunctionRec);
5411 type
5412   PglBitmapPixelData = ^TglBitmapPixelData;
5413 begin
5414   with FuncRec do begin
5415     Dest.Red   := PglBitmapPixelData(CustomData)^.Red;
5416     Dest.Green := PglBitmapPixelData(CustomData)^.Green;
5417     Dest.Blue  := PglBitmapPixelData(CustomData)^.Blue;
5418     Dest.Alpha := PglBitmapPixelData(CustomData)^.Alpha;
5419   end;
5420 end;
5421
5422
5423 procedure TglBitmap.FillWithColor(Red, Green, Blue: Byte; Alpha: Byte);
5424 begin
5425   FillWithColorFloat(Red / $FF, Green / $FF, Blue / $FF, Alpha / $FF);
5426 end;
5427
5428
5429 procedure TglBitmap.FillWithColorFloat(Red, Green, Blue: Single; Alpha: Single);
5430 var
5431   PixelData: TglBitmapPixelData;
5432 begin
5433   FormatPreparePixel(PixelData, InternalFormat);
5434
5435   PixelData.Red   := Max(0, Min(PixelData.PixelDesc.RedRange,   Trunc(PixelData.PixelDesc.RedRange   * Red)));
5436   PixelData.Green := Max(0, Min(PixelData.PixelDesc.GreenRange, Trunc(PixelData.PixelDesc.GreenRange * Green)));
5437   PixelData.Blue  := Max(0, Min(PixelData.PixelDesc.BlueRange,  Trunc(PixelData.PixelDesc.BlueRange  * Blue)));
5438   PixelData.Alpha := Max(0, Min(PixelData.PixelDesc.AlphaRange, Trunc(PixelData.PixelDesc.AlphaRange * Alpha)));
5439
5440   AddFunc(glBitmapFillWithColorFunc, False, @PixelData);
5441 end;
5442
5443
5444 procedure TglBitmap.FillWithColorRange(Red, Green, Blue: Cardinal;
5445   Alpha: Cardinal);
5446 var
5447   PixelData: TglBitmapPixelData;
5448 begin
5449   FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
5450
5451   FillWithColorFloat(
5452     Red   / PixelData.PixelDesc.RedRange,
5453     Green / PixelData.PixelDesc.GreenRange,
5454     Blue  / PixelData.PixelDesc.BlueRange,
5455     Alpha / PixelData.PixelDesc.AlphaRange);
5456 end;
5457
5458
5459
5460 procedure TglBitmap.SetInternalFormat(const aValue: TglBitmapFormat);
5461 begin
5462   if InternalFormat <> Value then begin
5463     if FormatGetSize(Value) <> FormatGetSize(InternalFormat) then
5464       raise EglBitmapUnsupportedFormatFormat.Create('SetInternalFormat - ' + UNSUPPORTED_INTERNAL_FORMAT);
5465
5466     // Update whatever
5467     SetDataPointer(Data, Value);
5468   end;
5469 end;
5470
5471
5472 function TglBitmap.AddFunc(Func: TglBitmapFunction; CreateTemp: Boolean;
5473   CustomData: Pointer): boolean;
5474 begin
5475   Result := AddFunc(Self, Func, CreateTemp, InternalFormat, CustomData);
5476 end;
5477
5478
5479 function TglBitmap.AddFunc(Source: TglBitmap; Func: TglBitmapFunction;
5480   CreateTemp: Boolean; Format: TglBitmapFormat; CustomData: Pointer): boolean;
5481 var
5482   pDest, NewImage, pSource: pByte;
5483   TempHeight, TempWidth: Integer;
5484   MapFunc: TglBitmapMapFunc;
5485   UnMapFunc: TglBitmapUnMapFunc;
5486
5487   FuncRec: TglBitmapFunctionRec;
5488 begin
5489   Assert(Assigned(Data));
5490   Assert(Assigned(Source));
5491   Assert(Assigned(Source.Data));
5492
5493   Result := False;
5494
5495   if Assigned (Source.Data) and FormatIsUncompressed(Format) and
5496      ((Source.Height > 0) or (Source.Width > 0)) then begin
5497
5498     // inkompatible Formats so CreateTemp
5499     if FormatGetSize(Format) <> FormatGetSize(InternalFormat) then
5500       CreateTemp := True;
5501
5502     // Values
5503     TempHeight := Max(1, Source.Height);
5504     TempWidth := Max(1, Source.Width);
5505
5506     FuncRec.Sender := Self;
5507     FuncRec.CustomData := CustomData;
5508
5509     NewImage := nil;
5510
5511     if CreateTemp then begin
5512       GetMem(NewImage, Trunc(FormatGetSize(Format) * TempHeight * TempWidth));
5513       pDest := NewImage;
5514     end
5515       else pDest := Data;
5516
5517     try
5518       // Mapping
5519       MapFunc := FormatGetMapFunc(Format);
5520       FormatPreparePixel(FuncRec.Dest, Format);
5521       FormatPreparePixel(FuncRec.Source, Source.InternalFormat);
5522
5523       FuncRec.Size := Source.Dimension;
5524       FuncRec.Position.Fields := FuncRec.Size.Fields;
5525
5526       if FormatIsUncompressed(Source.InternalFormat) then begin
5527         // Uncompressed Images
5528         pSource := Source.Data;
5529         UnMapFunc := FormatGetUnMapFunc(Source.InternalFormat);
5530
5531         FuncRec.Position.Y := 0;
5532         while FuncRec.Position.Y < TempHeight do begin
5533           FuncRec.Position.X := 0;
5534           while FuncRec.Position.X < TempWidth do begin
5535             // Get Data
5536             UnMapFunc(pSource, FuncRec.Source);
5537             // Func
5538             Func(FuncRec);
5539             // Set Data
5540             MapFunc(FuncRec.Dest, pDest);
5541             Inc(FuncRec.Position.X);
5542           end;
5543           Inc(FuncRec.Position.Y);
5544         end;
5545       end else begin
5546         // Compressed Images
5547         FuncRec.Position.Y := 0;
5548         while FuncRec.Position.Y < TempHeight do begin
5549           FuncRec.Position.X := 0;
5550           while FuncRec.Position.X < TempWidth do begin
5551             // Get Data
5552             fGetPixelFunc(FuncRec.Position, FuncRec.Source);
5553             // Func
5554             Func(FuncRec);
5555             // Set Data
5556             MapFunc(FuncRec.Dest, pDest);
5557             Inc(FuncRec.Position.X);
5558           end;
5559           Inc(FuncRec.Position.Y);
5560         end;
5561       end;
5562
5563       // Updating Image or InternalFormat
5564       if CreateTemp then
5565         SetDataPointer(NewImage, Format)
5566       else
5567
5568       if Format <> InternalFormat then
5569         SetInternalFormat(Format);
5570
5571       Result := True;
5572     except
5573       if CreateTemp
5574         then FreeMem(NewImage);
5575       raise;
5576     end;
5577   end;
5578 end;
5579
5580
5581 procedure glBitmapConvertCopyFunc(var FuncRec: TglBitmapFunctionRec);
5582 begin
5583   with FuncRec do begin
5584     if Source.PixelDesc.RedRange > 0 then
5585       Dest.Red   := Source.Red;
5586
5587     if Source.PixelDesc.GreenRange > 0 then
5588       Dest.Green := Source.Green;
5589
5590     if Source.PixelDesc.BlueRange > 0 then
5591       Dest.Blue  := Source.Blue;
5592
5593     if Source.PixelDesc.AlphaRange > 0 then
5594       Dest.Alpha := Source.Alpha;
5595   end;
5596 end;
5597
5598
5599 procedure glBitmapConvertCalculateRGBAFunc(var FuncRec: TglBitmapFunctionRec);
5600 begin
5601   with FuncRec do begin
5602     if Source.PixelDesc.RedRange > 0 then
5603       Dest.Red   := Round(Dest.PixelDesc.RedRange   * Source.Red   / Source.PixelDesc.RedRange);
5604
5605     if Source.PixelDesc.GreenRange > 0 then
5606       Dest.Green := Round(Dest.PixelDesc.GreenRange * Source.Green / Source.PixelDesc.GreenRange);
5607
5608     if Source.PixelDesc.BlueRange > 0 then
5609       Dest.Blue  := Round(Dest.PixelDesc.BlueRange  * Source.Blue  / Source.PixelDesc.BlueRange);
5610
5611     if Source.PixelDesc.AlphaRange > 0 then
5612       Dest.Alpha := Round(Dest.PixelDesc.AlphaRange * Source.Alpha / Source.PixelDesc.AlphaRange);
5613   end;
5614 end;
5615
5616
5617 procedure glBitmapConvertShiftRGBAFunc(var FuncRec: TglBitmapFunctionRec);
5618 begin
5619   with FuncRec do
5620     with TglBitmapPixelDesc(CustomData^) do begin
5621       if Source.PixelDesc.RedRange > 0 then
5622         Dest.Red   := Source.Red   shr RedShift;
5623
5624       if Source.PixelDesc.GreenRange > 0 then
5625         Dest.Green := Source.Green shr GreenShift;
5626
5627       if Source.PixelDesc.BlueRange > 0 then
5628         Dest.Blue  := Source.Blue  shr BlueShift;
5629
5630       if Source.PixelDesc.AlphaRange > 0 then
5631         Dest.Alpha := Source.Alpha shr AlphaShift;
5632     end;
5633 end;
5634
5635
5636 function TglBitmap.ConvertTo(NewFormat: TglBitmapFormat): boolean;
5637 var
5638   Source, Dest: TglBitmapPixelData;
5639   PixelDesc: TglBitmapPixelDesc;
5640
5641   function CopyDirect: Boolean;
5642   begin
5643     Result :=
5644       ((Source.PixelDesc.RedRange   = Dest.PixelDesc.RedRange)   or (Source.PixelDesc.RedRange   = 0) or (Dest.PixelDesc.RedRange   = 0)) and
5645       ((Source.PixelDesc.GreenRange = Dest.PixelDesc.GreenRange) or (Source.PixelDesc.GreenRange = 0) or (Dest.PixelDesc.GreenRange = 0)) and
5646       ((Source.PixelDesc.BlueRange  = Dest.PixelDesc.BlueRange)  or (Source.PixelDesc.BlueRange  = 0) or (Dest.PixelDesc.BlueRange  = 0)) and
5647       ((Source.PixelDesc.AlphaRange = Dest.PixelDesc.AlphaRange) or (Source.PixelDesc.AlphaRange = 0) or (Dest.PixelDesc.AlphaRange = 0));
5648   end;
5649
5650   function CanShift: Boolean;
5651   begin
5652     Result :=
5653       ((Source.PixelDesc.RedRange   >= Dest.PixelDesc.RedRange  ) or (Source.PixelDesc.RedRange   = 0) or (Dest.PixelDesc.RedRange   = 0)) and
5654       ((Source.PixelDesc.GreenRange >= Dest.PixelDesc.GreenRange) or (Source.PixelDesc.GreenRange = 0) or (Dest.PixelDesc.GreenRange = 0)) and
5655       ((Source.PixelDesc.BlueRange  >= Dest.PixelDesc.BlueRange ) or (Source.PixelDesc.BlueRange  = 0) or (Dest.PixelDesc.BlueRange  = 0)) and
5656       ((Source.PixelDesc.AlphaRange >= Dest.PixelDesc.AlphaRange) or (Source.PixelDesc.AlphaRange = 0) or (Dest.PixelDesc.AlphaRange = 0));
5657   end;
5658
5659   function GetShift(Source, Dest: Cardinal) : ShortInt;
5660   begin
5661     Result := 0;
5662
5663     while (Source > Dest) and (Source > 0) do begin
5664       Inc(Result);
5665       Source := Source shr 1;
5666     end;
5667   end;
5668
5669 begin
5670   if NewFormat <> InternalFormat then begin
5671     FormatPreparePixel(Source, InternalFormat);
5672     FormatPreparePixel(Dest, NewFormat);
5673
5674     if CopyDirect then
5675       Result := AddFunc(Self, glBitmapConvertCopyFunc, False, NewFormat)
5676     else
5677     if CanShift then begin
5678       PixelDesc.RedShift   := GetShift(Source.PixelDesc.RedRange,   Dest.PixelDesc.RedRange);
5679       PixelDesc.GreenShift := GetShift(Source.PixelDesc.GreenRange, Dest.PixelDesc.GreenRange);
5680       PixelDesc.BlueShift  := GetShift(Source.PixelDesc.BlueRange,  Dest.PixelDesc.BlueRange);
5681       PixelDesc.AlphaShift := GetShift(Source.PixelDesc.AlphaRange, Dest.PixelDesc.AlphaRange);
5682
5683       Result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, False, NewFormat, @PixelDesc);
5684     end
5685       else Result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, False, NewFormat);
5686   end
5687     else Result := True;
5688 end;
5689
5690
5691 function TglBitmap.RemoveAlpha: Boolean;
5692 begin
5693   Result := False;
5694
5695   if (Assigned(Data)) then begin
5696     if not (FormatIsUncompressed(InternalFormat) or FormatHasAlpha(InternalFormat)) then
5697       raise EglBitmapUnsupportedFormatFormat.Create('RemoveAlpha - ' + UNSUPPORTED_INTERNAL_FORMAT);
5698
5699     Result := ConvertTo(FormatGetWithoutAlpha(InternalFormat));
5700   end;
5701 end;
5702
5703
5704 function TglBitmap.AddAlphaFromFunc(Func: TglBitmapFunction; CustomData: Pointer): boolean;
5705 begin
5706   if not FormatIsUncompressed(InternalFormat) then
5707     raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_INTERNAL_FORMAT);
5708
5709   Result := AddFunc(Self, Func, False, FormatGetWithAlpha(InternalFormat), CustomData);
5710 end;
5711
5712
5713 function TglBitmap.GetFileHeight: Integer;
5714 begin
5715   Result := Max(1, Height);
5716 end;
5717
5718
5719 function TglBitmap.GetFileWidth: Integer;
5720 begin
5721   Result := Max(1, Width);
5722 end;
5723
5724
5725 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
5726 var
5727   Temp: Single;
5728 begin
5729   with FuncRec do begin
5730     Temp :=
5731       Source.Red   / Source.PixelDesc.RedRange   * 0.3 +
5732       Source.Green / Source.PixelDesc.GreenRange * 0.59 +
5733       Source.Blue  / Source.PixelDesc.BlueRange  * 0.11;
5734
5735     Dest.Alpha := Round (Dest.PixelDesc.AlphaRange * Temp);
5736   end;
5737 end;
5738
5739
5740 function TglBitmap.AddAlphaFromglBitmap(glBitmap: TglBitmap; Func: TglBitmapFunction; CustomData: Pointer): boolean;
5741 var
5742   pDest, pDest2, pSource: pByte;
5743   TempHeight, TempWidth: Integer;
5744   MapFunc: TglBitmapMapFunc;
5745   DestUnMapFunc, UnMapFunc: TglBitmapUnMapFunc;
5746
5747   FuncRec: TglBitmapFunctionRec;
5748 begin
5749   Result := False;
5750
5751   assert(Assigned(Data));
5752   assert(Assigned(glBitmap));
5753   assert(Assigned(glBitmap.Data));
5754
5755   if ((glBitmap.Width = Width) and (glBitmap.Height = Height)) then begin
5756     // Convert to Data with Alpha
5757     Result := ConvertTo(FormatGetWithAlpha(FormatGetUncompressed(InternalFormat)));
5758
5759     if not Assigned(Func) then
5760       Func := glBitmapAlphaFunc;
5761
5762     // Values
5763     TempHeight := glBitmap.FileHeight;
5764     TempWidth := glBitmap.FileWidth;
5765
5766     FuncRec.Sender := Self;
5767     FuncRec.CustomData := CustomData;
5768
5769     pDest := Data;
5770     pDest2 := Data;
5771     pSource := glBitmap.Data;
5772
5773     // Mapping
5774     FormatPreparePixel(FuncRec.Dest, InternalFormat);
5775     FormatPreparePixel(FuncRec.Source, glBitmap.InternalFormat);
5776     MapFunc := FormatGetMapFunc(InternalFormat);
5777     DestUnMapFunc := FormatGetUnMapFunc(InternalFormat);
5778     UnMapFunc := FormatGetUnMapFunc(glBitmap.InternalFormat);
5779
5780     FuncRec.Size := Dimension;
5781     FuncRec.Position.Fields := FuncRec.Size.Fields;
5782
5783     FuncRec.Position.Y := 0;
5784     while FuncRec.Position.Y < TempHeight do begin
5785       FuncRec.Position.X := 0;
5786       while FuncRec.Position.X < TempWidth do begin
5787         // Get Data
5788         UnMapFunc(pSource, FuncRec.Source);
5789         DestUnMapFunc(pDest2, FuncRec.Dest);
5790         // Func
5791         Func(FuncRec);
5792         // Set Data
5793         MapFunc(FuncRec.Dest, pDest);
5794         Inc(FuncRec.Position.X);
5795       end;
5796       Inc(FuncRec.Position.Y);
5797     end;
5798   end;
5799 end;
5800
5801
5802 procedure TglBitmap.SetBorderColor(Red, Green, Blue, Alpha: Single);
5803 begin
5804   fBorderColor[0] := Red;
5805   fBorderColor[1] := Green;
5806   fBorderColor[2] := Blue;
5807   fBorderColor[3] := Alpha;
5808
5809   if ID > 0 then begin
5810     Bind (False);
5811
5812     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5813   end;
5814 end;
5815
5816
5817 { TglBitmap2D }
5818
5819 procedure TglBitmap2D.SetDataPointer(Data: pByte; Format: TglBitmapFormat; Width, Height: Integer);
5820 var
5821   Idx, LineWidth: Integer;
5822 begin
5823   inherited;
5824
5825   // Format
5826   if FormatIsUncompressed(Format) then begin
5827     fUnmapFunc := FormatGetUnMapFunc(Format);
5828     fGetPixelFunc := GetPixel2DUnmap;
5829
5830     fMapFunc := FormatGetMapFunc(Format);
5831     fSetPixelFunc := SetPixel2DUnmap;
5832
5833     // Assigning Data
5834     if Assigned(Data) then begin
5835       SetLength(fLines, GetHeight);
5836
5837       LineWidth := Trunc(GetWidth * FormatGetSize(InternalFormat));
5838
5839       for Idx := 0 to GetHeight -1 do begin
5840         fLines[Idx] := Data;
5841         Inc(fLines[Idx], Idx * LineWidth);
5842       end;
5843     end
5844       else SetLength(fLines, 0);
5845   end else begin
5846     SetLength(fLines, 0);
5847
5848     fSetPixelFunc := nil;
5849
5850     case Format of
5851       ifDXT1:
5852         fGetPixelFunc := GetPixel2DDXT1;
5853       ifDXT3:
5854         fGetPixelFunc := GetPixel2DDXT3;
5855       ifDXT5:
5856         fGetPixelFunc := GetPixel2DDXT5;
5857       else
5858         fGetPixelFunc := nil;
5859     end;
5860   end;
5861 end;
5862
5863
5864 procedure TglBitmap2D.GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
5865 type
5866   PDXT1Chunk = ^TDXT1Chunk;
5867   TDXT1Chunk = packed record
5868     Color1: WORD;
5869     Color2: WORD;
5870     Pixels: array [0..3] of byte;
5871   end;
5872
5873 var
5874   BasePtr: pDXT1Chunk;
5875   PixPos: Integer;
5876   Colors: array [0..3] of TRGBQuad;
5877 begin
5878   BasePtr := pDXT1Chunk(pData);
5879
5880   PixPos := BasePtr^.Pixels[relY] shr (relX * 2) and $3;
5881
5882   if PixPos in [0, 2, 3] then begin
5883     Colors[0].rgbRed      := BasePtr^.Color1 and $F800 shr 8;
5884     Colors[0].rgbGreen    := BasePtr^.Color1 and $07E0 shr 3;
5885     Colors[0].rgbBlue     := BasePtr^.Color1 and $001F shl 3;
5886     Colors[0].rgbReserved := 255;
5887   end;
5888
5889   if PixPos in [1, 2, 3] then begin
5890     Colors[1].rgbRed      := BasePtr^.Color2 and $F800 shr 8;
5891     Colors[1].rgbGreen    := BasePtr^.Color2 and $07E0 shr 3;
5892     Colors[1].rgbBlue     := BasePtr^.Color2 and $001F shl 3;
5893     Colors[1].rgbReserved := 255;
5894   end;
5895
5896   if PixPos = 2 then begin
5897     Colors[2].rgbRed      := (Colors[0].rgbRed   * 67 + Colors[1].rgbRed   * 33) div 100;
5898     Colors[2].rgbGreen    := (Colors[0].rgbGreen * 67 + Colors[1].rgbGreen * 33) div 100;
5899     Colors[2].rgbBlue     := (Colors[0].rgbBlue  * 67 + Colors[1].rgbBlue  * 33) div 100;
5900     Colors[2].rgbReserved := 255;
5901   end;
5902
5903   if PixPos = 3 then begin
5904     Colors[3].rgbRed      := (Colors[0].rgbRed   * 33 + Colors[1].rgbRed   * 67) div 100;
5905     Colors[3].rgbGreen    := (Colors[0].rgbGreen * 33 + Colors[1].rgbGreen * 67) div 100;
5906     Colors[3].rgbBlue     := (Colors[0].rgbBlue  * 33 + Colors[1].rgbBlue  * 67) div 100;
5907     if BasePtr^.Color1 > BasePtr^.Color2 then
5908       Colors[3].rgbReserved := 255
5909     else
5910       Colors[3].rgbReserved := 0;
5911   end;
5912
5913   Pixel.Red   := Colors[PixPos].rgbRed;
5914   Pixel.Green := Colors[PixPos].rgbGreen;
5915   Pixel.Blue  := Colors[PixPos].rgbBlue;
5916   Pixel.Alpha := Colors[PixPos].rgbReserved;
5917 end;
5918
5919
5920 procedure TglBitmap2D.GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
5921 var
5922   BasePtr: pByte;
5923   PosX, PosY: Integer;
5924 begin
5925   inherited;
5926
5927   if (Pos.Y <= Height) and (Pos.X <= Width) then begin
5928     PosX := Pos.X div 4;
5929     PosY := Pos.Y div 4;
5930
5931     BasePtr := Data;
5932     Inc(BasePtr, (PosY * Width div 4 + PosX) * 8);
5933
5934     GetDXTColorBlock(BasePtr, Pos.X - PosX * 4, Pos.Y - PosY * 4, Pixel);
5935   end;
5936 end;
5937
5938
5939 procedure TglBitmap2D.GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
5940 type
5941   PDXT3AlphaChunk = ^TDXT3AlphaChunk;
5942   TDXT3AlphaChunk = array [0..3] of WORD;
5943
5944 var
5945   ColorPtr: pByte;
5946   AlphaPtr: PDXT3AlphaChunk;
5947   PosX, PosY, relX, relY: Integer;
5948 begin
5949   inherited;
5950
5951   if (Pos.Y <= Height) and (Pos.X <= Width) then begin
5952     PosX := Pos.X div 4;
5953     PosY := Pos.Y div 4;
5954     relX := Pos.X - PosX * 4;
5955     relY := Pos.Y - PosY * 4;
5956
5957     // get color value
5958     AlphaPtr := PDXT3AlphaChunk(Data);
5959     Inc(AlphaPtr, (PosY * Width div 4 + PosX) * 2);
5960
5961     ColorPtr := pByte(AlphaPtr);
5962     Inc(ColorPtr, 8);
5963
5964     GetDXTColorBlock(ColorPtr, relX, relY, Pixel);
5965
5966     // extracting alpha
5967     Pixel.Alpha := AlphaPtr^[relY] shr (4 * relX) and $0F shl 4;
5968   end;
5969 end;
5970
5971
5972 procedure TglBitmap2D.GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
5973 var
5974   ColorPtr: pByte;
5975   AlphaPtr: PInt64;
5976   PixPos, PosX, PosY, relX, relY: Integer;
5977   Alpha0, Alpha1: Byte;
5978 begin
5979   inherited;
5980
5981   if (Pos.Y <= Height) and (Pos.X <= Width) then begin
5982     PosX := Pos.X div 4;
5983     PosY := Pos.Y div 4;
5984     relX := Pos.X - PosX * 4;
5985     relY := Pos.Y - PosY * 4;
5986
5987     // get color value
5988     AlphaPtr := PInt64(Data);
5989     Inc(AlphaPtr, (PosY * Width div 4 + PosX) * 2);
5990
5991     ColorPtr := pByte(AlphaPtr);
5992     Inc(ColorPtr, 8);
5993
5994     GetDXTColorBlock(ColorPtr, relX, relY, Pixel);
5995
5996     // extracting alpha
5997     Alpha0 := AlphaPtr^ and $FF;
5998     Alpha1 := AlphaPtr^ shr 8 and $FF;
5999
6000     PixPos := AlphaPtr^ shr (16 + (relY * 4 + relX) * 3) and $07;
6001
6002     // use alpha 0
6003     if PixPos = 0 then begin
6004       Pixel.Alpha := Alpha0;
6005     end else
6006
6007     // use alpha 1
6008     if PixPos = 1 then begin
6009       Pixel.Alpha := Alpha1;
6010     end else
6011
6012     // alpha interpolate 7 Steps
6013     if Alpha0 > Alpha1 then begin
6014       Pixel.Alpha := ((8 - PixPos) * Alpha0 + (PixPos - 1) * Alpha1) div 7;
6015     end else
6016
6017     // alpha is 100% transparent or not transparent
6018     if PixPos >= 6 then begin
6019       if PixPos = 6 then
6020         Pixel.Alpha := 0
6021       else
6022         Pixel.Alpha := 255;
6023     end else
6024
6025     // alpha interpolate 5 Steps
6026     begin
6027       Pixel.Alpha := ((6 - PixPos) * Alpha0 + (PixPos - 1) * Alpha1) div 5;
6028     end;
6029   end;
6030 end;
6031
6032
6033 procedure TglBitmap2D.GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
6034 var
6035   pTemp: pByte;
6036 begin
6037   pTemp := fLines[Pos.Y];
6038   Inc(pTemp, Pos.X * fPixelSize);
6039
6040   fUnmapFunc(pTemp, Pixel);
6041 end;
6042
6043
6044 procedure TglBitmap2D.SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
6045 var
6046   pTemp: pByte;
6047 begin
6048   pTemp := fLines[Pos.Y];
6049   Inc(pTemp, Pos.X * fPixelSize);
6050
6051   fMapFunc(Pixel, pTemp);
6052 end;
6053
6054
6055 function TglBitmap2D.FlipHorz: Boolean;
6056 var
6057   Col, Row: Integer;
6058   pTempDest, pDest, pSource: pByte;
6059   ImgSize: Integer;
6060 begin
6061   Result := Inherited FlipHorz;
6062
6063   if Assigned(Data) then begin
6064     pSource := Data;
6065     ImgSize := Height * fRowSize;
6066
6067     GetMem(pDest, ImgSize);
6068     try
6069       pTempDest := pDest;
6070
6071       Dec(pTempDest, fRowSize + fPixelSize);
6072       for Row := 0 to Height -1 do begin
6073         Inc(pTempDest, fRowSize * 2);
6074         for Col := 0 to Width -1 do begin
6075           Move(pSource^, pTempDest^, fPixelSize);
6076
6077           Inc(pSource, fPixelSize);
6078           Dec(pTempDest, fPixelSize);
6079         end;
6080       end;
6081
6082       SetDataPointer(pDest, InternalFormat);
6083
6084       Result := True;
6085     except
6086       FreeMem(pDest);
6087       raise;
6088     end;
6089   end;
6090 end;
6091
6092
6093 function TglBitmap2D.FlipVert: Boolean;
6094 var
6095   Row: Integer;
6096   pTempDest, pDest, pSource: pByte;
6097 begin
6098   Result := Inherited FlipVert;
6099
6100   if Assigned(Data) then begin
6101     pSource := Data;
6102     GetMem(pDest, Height * fRowSize);
6103     try
6104       pTempDest := pDest;
6105
6106       Inc(pTempDest, Width * (Height -1) * fPixelSize);
6107
6108       for Row := 0 to Height -1 do begin
6109         Move(pSource^, pTempDest^, fRowSize);
6110
6111         Dec(pTempDest, fRowSize);
6112         Inc(pSource, fRowSize);
6113       end;
6114
6115       SetDataPointer(pDest, InternalFormat);
6116
6117       Result := True;
6118     except
6119       FreeMem(pDest);
6120       raise;
6121     end;
6122   end;
6123 end;
6124
6125
6126 procedure TglBitmap2D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
6127 begin
6128   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
6129
6130   // Upload data
6131   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
6132     glCompressedTexImage2D(Target, 0, InternalFormat, Width, Height, 0, Trunc(Width * Height * FormatGetSize(Self.InternalFormat)), Data)
6133   else
6134
6135   if BuildWithGlu then
6136     gluBuild2DMipmaps(Target, InternalFormat, Width, Height, Format, Typ, Data)
6137   else
6138     glTexImage2D(Target, 0, InternalFormat, Width, Height, 0, Format, Typ, Data);
6139
6140   // Freigeben
6141   if (FreeDataAfterGenTexture) then
6142     FreeData;
6143 end;
6144
6145
6146 procedure TglBitmap2D.GenTexture(TestTextureSize: Boolean);
6147 var
6148   BuildWithGlu, PotTex, TexRec: Boolean;
6149   glFormat, glInternalFormat, glType: Cardinal;
6150   TexSize: Integer;
6151 begin
6152   if Assigned(Data) then begin
6153     // Check Texture Size
6154     if (TestTextureSize) then begin
6155       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
6156
6157       if ((Height > TexSize) or (Width > TexSize)) then
6158         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
6159
6160       PotTex := IsPowerOfTwo (Height) and IsPowerOfTwo (Width);
6161       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
6162                 (Target = GL_TEXTURE_RECTANGLE_ARB);
6163
6164       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
6165         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
6166     end;
6167
6168     CreateId;
6169
6170     SetupParameters(BuildWithGlu);
6171     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
6172
6173     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
6174
6175     // Infos sammeln
6176     glAreTexturesResident(1, @ID, @fIsResident);
6177   end;
6178 end;
6179
6180
6181 procedure TglBitmap2D.AfterConstruction;
6182 begin
6183   inherited;
6184
6185   Target := GL_TEXTURE_2D;
6186 end;
6187
6188
6189 type
6190   TMatrixItem = record
6191     X, Y: Integer;
6192     W: Single;
6193   end;
6194
6195   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
6196   TglBitmapToNormalMapRec = Record
6197     Scale: Single;
6198     Heights: array of Single;
6199     MatrixU : array of TMatrixItem;
6200     MatrixV : array of TMatrixItem;
6201   end;
6202
6203 const
6204   oneover255 = 1 / 255;
6205
6206 procedure glBitmapToNormalMapPrepareFunc (var FuncRec: TglBitmapFunctionRec);
6207 var
6208   Val: Single;
6209 begin
6210   with FuncRec do begin
6211     Val := Source.Red * 0.3 + Source.Green * 0.59 + Source.Blue *  0.11;
6212     PglBitmapToNormalMapRec (CustomData)^.Heights[Position.Y * Size.X + Position.X] := Val * oneover255;
6213   end;
6214 end;
6215
6216
6217 procedure glBitmapToNormalMapPrepareAlphaFunc (var FuncRec: TglBitmapFunctionRec);
6218 begin
6219   with FuncRec do
6220     PglBitmapToNormalMapRec (CustomData)^.Heights[Position.Y * Size.X + Position.X] := Source.Alpha * oneover255;
6221 end;
6222
6223
6224 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
6225 type
6226   TVec = Array[0..2] of Single;
6227 var
6228   Idx: Integer;
6229   du, dv: Double;
6230   Len: Single;
6231   Vec: TVec;
6232
6233   function GetHeight(X, Y: Integer): Single;
6234   begin
6235     with FuncRec do begin
6236       X := Max(0, Min(Size.X -1, X));
6237       Y := Max(0, Min(Size.Y -1, Y));
6238
6239       Result := PglBitmapToNormalMapRec (CustomData)^.Heights[Y * Size.X + X];
6240     end;
6241   end;
6242
6243 begin
6244   with FuncRec do begin
6245     with PglBitmapToNormalMapRec (CustomData)^ do begin
6246       du := 0;
6247       for Idx := Low(MatrixU) to High(MatrixU) do
6248         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
6249
6250       dv := 0;
6251       for Idx := Low(MatrixU) to High(MatrixU) do
6252         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
6253
6254       Vec[0] := -du * Scale;
6255       Vec[1] := -dv * Scale;
6256       Vec[2] := 1;
6257     end;
6258
6259     // Normalize
6260     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
6261     if Len <> 0 then begin
6262       Vec[0] := Vec[0] * Len;
6263       Vec[1] := Vec[1] * Len;
6264       Vec[2] := Vec[2] * Len;
6265     end;
6266
6267     // Farbe zuweisem
6268     Dest.Red   := Trunc((Vec[0] + 1) * 127.5);
6269     Dest.Green := Trunc((Vec[1] + 1) * 127.5);
6270     Dest.Blue  := Trunc((Vec[2] + 1) * 127.5);
6271   end;
6272 end;
6273
6274
6275 procedure TglBitmap2D.ToNormalMap(Func: TglBitmapNormalMapFunc; Scale: Single; UseAlpha: Boolean);
6276 var
6277   Rec: TglBitmapToNormalMapRec;
6278
6279   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
6280   begin
6281     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
6282       Matrix[Index].X := X;
6283       Matrix[Index].Y := Y;
6284       Matrix[Index].W := W;
6285     end;
6286   end;
6287
6288 begin
6289   if not FormatIsUncompressed(InternalFormat) then
6290     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_INTERNAL_FORMAT);
6291
6292   if Scale > 100 then
6293     Rec.Scale := 100
6294   else
6295   if Scale < -100 then
6296     Rec.Scale := -100
6297   else
6298     Rec.Scale := Scale;
6299
6300   SetLength(Rec.Heights, Width * Height);
6301   try
6302     case Func of
6303       nm4Samples:
6304         begin
6305           SetLength(Rec.MatrixU, 2);
6306           SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
6307           SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
6308
6309           SetLength(Rec.MatrixV, 2);
6310           SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
6311           SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
6312         end;
6313       nmSobel:
6314         begin
6315           SetLength(Rec.MatrixU, 6);
6316           SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
6317           SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
6318           SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
6319           SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
6320           SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
6321           SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
6322
6323           SetLength(Rec.MatrixV, 6);
6324           SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
6325           SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
6326           SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
6327           SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
6328           SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
6329           SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
6330         end;
6331       nm3x3:
6332         begin
6333           SetLength(Rec.MatrixU, 6);
6334           SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
6335           SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
6336           SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
6337           SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
6338           SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
6339           SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
6340
6341           SetLength(Rec.MatrixV, 6);
6342           SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
6343           SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
6344           SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
6345           SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
6346           SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
6347           SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
6348         end;
6349       nm5x5:
6350         begin
6351           SetLength(Rec.MatrixU, 20);
6352           SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
6353           SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
6354           SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
6355           SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
6356           SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
6357           SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
6358           SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
6359           SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
6360           SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
6361           SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
6362           SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
6363           SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
6364           SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
6365           SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
6366           SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
6367           SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
6368           SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
6369           SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
6370           SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
6371           SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
6372
6373           SetLength(Rec.MatrixV, 20);
6374           SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
6375           SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
6376           SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
6377           SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
6378           SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
6379           SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
6380           SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
6381           SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
6382           SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
6383           SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
6384           SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
6385           SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
6386           SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
6387           SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
6388           SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
6389           SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
6390           SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
6391           SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
6392           SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
6393           SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
6394         end;
6395     end;
6396
6397     // Daten Sammeln
6398     if UseAlpha and FormatHasAlpha(InternalFormat) then
6399       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, False, @Rec)
6400     else
6401       AddFunc(glBitmapToNormalMapPrepareFunc, False, @Rec);
6402
6403     // Neues Bild berechnen
6404     AddFunc(glBitmapToNormalMapFunc, False, @Rec);
6405   finally
6406     SetLength(Rec.Heights, 0);
6407   end;
6408 end;
6409
6410
6411 procedure TglBitmap2D.GrabScreen(Top, Left, Right, Bottom: Integer; Format: TglBitmapFormat);
6412 var
6413   Temp: pByte;
6414   Size: Integer;
6415   glFormat, glInternalFormat, glType: Cardinal;
6416 begin
6417   if not FormatIsUncompressed(Format) then
6418     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_INTERNAL_FORMAT);
6419
6420   // Only to select Formats
6421   SelectFormat(Format, glFormat, glInternalFormat, glType, False);
6422
6423   Size := FormatGetImageSize(glBitmapPosition(Right - Left, Bottom - Top), Format);
6424   GetMem(Temp, Size);
6425   try
6426     glPixelStorei(GL_PACK_ALIGNMENT, 1);
6427     glReadPixels(Left, Top, Right - Left, Bottom - Top, glFormat, glType, Temp);
6428
6429     // Set Data
6430     SetDataPointer(Temp, Format, Right - Left, Bottom - Top);
6431
6432     // Flip
6433     FlipVert;
6434   except
6435     FreeMem(Temp);
6436     raise;
6437   end;
6438 end;
6439
6440
6441 procedure TglBitmap2D.GetDataFromTexture;
6442 var
6443   Temp: pByte;
6444   TempWidth, TempHeight, RedSize, GreenSize, BlueSize, AlphaSize, LumSize: Integer;
6445   TempType, TempIntFormat: Cardinal;
6446   IntFormat: TglBitmapFormat;
6447 begin
6448   Bind;
6449
6450   // Request Data
6451   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
6452   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
6453   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
6454
6455   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_RED_SIZE, @RedSize);
6456   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_GREEN_SIZE, @GreenSize);
6457   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_BLUE_SIZE, @BlueSize);
6458   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_ALPHA_SIZE, @AlphaSize);
6459   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_LUMINANCE_SIZE, @LumSize);
6460
6461   // Get glBitmapInternalFormat from TempIntFormat
6462   TempType := GL_UNSIGNED_BYTE;
6463   case TempIntFormat of
6464     GL_ALPHA:
6465       IntFormat := ifAlpha;
6466     GL_LUMINANCE:
6467       IntFormat := ifLuminance;
6468     GL_LUMINANCE_ALPHA:
6469       IntFormat := ifLuminanceAlpha;
6470     GL_RGB4:
6471       begin
6472         IntFormat := ifR5G6B5;
6473         TempIntFormat := GL_RGB;
6474         TempType := GL_UNSIGNED_SHORT_5_6_5;
6475       end;
6476     GL_RGB, GL_RGB8:
6477       IntFormat := tfRGB8;
6478     GL_RGBA, GL_RGBA4, GL_RGBA8:
6479       begin
6480         if (RedSize = 4) and (BlueSize = 4) and (GreenSize = 4) and (AlphaSize = 4) then begin
6481           IntFormat := tfRGBA4;
6482           TempIntFormat := GL_BGRA;
6483           TempType := GL_UNSIGNED_SHORT_4_4_4_4_REV;
6484         end else
6485         if (RedSize = 5) and (BlueSize = 5) and (GreenSize = 5) and (AlphaSize = 1) then begin
6486           IntFormat := tfRGB5A1;
6487           TempIntFormat := GL_BGRA;
6488           TempType := GL_UNSIGNED_SHORT_1_5_5_5_REV;
6489         end else begin
6490           IntFormat := tfRGBA8;
6491         end;
6492       end;
6493     GL_BGR:
6494       IntFormat := ifBGR8;
6495     GL_BGRA:
6496       IntFormat := ifBGRA8;
6497     GL_COMPRESSED_RGB_S3TC_DXT1_EXT:
6498       IntFormat := ifDXT1;
6499     GL_COMPRESSED_RGBA_S3TC_DXT1_EXT:
6500       IntFormat := ifDXT1;
6501     GL_COMPRESSED_RGBA_S3TC_DXT3_EXT:
6502       IntFormat := ifDXT3;
6503     GL_COMPRESSED_RGBA_S3TC_DXT5_EXT:
6504       IntFormat := ifDXT5;
6505     else
6506       IntFormat := ifEmpty;
6507   end;
6508
6509   // Getting data from OpenGL
6510   GetMem(Temp, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
6511   try
6512     if FormatIsCompressed(IntFormat) and (GL_VERSION_1_3 or GL_ARB_texture_compression) then
6513       glGetCompressedTexImage(Target, 0, Temp)
6514     else
6515       glGetTexImage(Target, 0, TempIntFormat, TempType, Temp);
6516
6517     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
6518   except
6519     FreeMem(Temp);
6520     raise;
6521   end;
6522 end;
6523
6524
6525 function TglBitmap2D.GetScanline(Index: Integer): Pointer;
6526 begin
6527   if (Index >= Low(fLines)) and (Index <= High(fLines)) then
6528     Result := fLines[Index]
6529   else
6530     Result := nil;
6531 end;
6532
6533
6534 { TglBitmap1D }
6535
6536 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
6537 var
6538   pTemp: pByte;
6539   Size: Integer;
6540 begin
6541   if Height > 1 then begin
6542     // extract first line of the data
6543     Size := FormatGetImageSize(glBitmapPosition(Width), Format);
6544     GetMem(pTemp, Size);
6545
6546     Move(Data^, pTemp^, Size);
6547
6548     FreeMem(Data);
6549   end else
6550     pTemp := Data;
6551
6552   // set data pointer
6553   inherited SetDataPointer(pTemp, Format, Width);
6554
6555   if FormatIsUncompressed(Format) then begin
6556     fUnmapFunc := FormatGetUnMapFunc(Format);
6557     fGetPixelFunc := GetPixel1DUnmap;
6558   end;
6559 end;
6560
6561
6562 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
6563 var
6564   pTemp: pByte;
6565 begin
6566   pTemp := Data;
6567   Inc(pTemp, Pos.X * fPixelSize);
6568
6569   fUnmapFunc(pTemp, Pixel);
6570 end;
6571
6572
6573 function TglBitmap1D.FlipHorz: Boolean;
6574 var
6575   Col: Integer;
6576   pTempDest, pDest, pSource: pByte;
6577 begin
6578   Result := Inherited FlipHorz;
6579
6580   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
6581     pSource := Data;
6582
6583     GetMem(pDest, fRowSize);
6584     try
6585       pTempDest := pDest;
6586
6587       Inc(pTempDest, fRowSize);
6588       for Col := 0 to Width -1 do begin
6589         Move(pSource^, pTempDest^, fPixelSize);
6590
6591         Inc(pSource, fPixelSize);
6592         Dec(pTempDest, fPixelSize);
6593       end;
6594
6595       SetDataPointer(pDest, InternalFormat);
6596
6597       Result := True;
6598     finally
6599       FreeMem(pDest);
6600     end;
6601   end;
6602 end;
6603
6604
6605 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
6606 begin
6607   // Upload data
6608   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
6609     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
6610   else
6611
6612   // Upload data
6613   if BuildWithGlu then
6614     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
6615   else
6616     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
6617
6618   // Freigeben
6619   if (FreeDataAfterGenTexture) then
6620     FreeData;
6621 end;
6622
6623
6624 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
6625 var
6626   BuildWithGlu, TexRec: Boolean;
6627   glFormat, glInternalFormat, glType: Cardinal;
6628   TexSize: Integer;
6629 begin
6630   if Assigned(Data) then begin
6631     // Check Texture Size
6632     if (TestTextureSize) then begin
6633       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
6634
6635       if (Width > TexSize) then
6636         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
6637
6638       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
6639                 (Target = GL_TEXTURE_RECTANGLE_ARB);
6640
6641       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
6642         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
6643     end;
6644
6645     CreateId;
6646
6647     SetupParameters(BuildWithGlu);
6648     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
6649
6650     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
6651
6652     // Infos sammeln
6653     glAreTexturesResident(1, @ID, @fIsResident);
6654   end;
6655 end;
6656
6657
6658 procedure TglBitmap1D.AfterConstruction;
6659 begin
6660   inherited;
6661
6662   Target := GL_TEXTURE_1D;
6663 end;
6664
6665
6666 { TglBitmapCubeMap }
6667
6668 procedure TglBitmapCubeMap.AfterConstruction;
6669 begin
6670   inherited;
6671
6672   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
6673     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
6674
6675   SetWrap; // set all to GL_CLAMP_TO_EDGE
6676   Target := GL_TEXTURE_CUBE_MAP;
6677   fGenMode := GL_REFLECTION_MAP;
6678 end;
6679
6680
6681 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
6682 begin
6683   inherited Bind (EnableTextureUnit);
6684
6685   if EnableTexCoordsGen then begin
6686     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
6687     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
6688     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
6689     glEnable(GL_TEXTURE_GEN_S);
6690     glEnable(GL_TEXTURE_GEN_T);
6691     glEnable(GL_TEXTURE_GEN_R);
6692   end;
6693 end;
6694
6695
6696 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
6697 var
6698   glFormat, glInternalFormat, glType: Cardinal;
6699   BuildWithGlu: Boolean;
6700   TexSize: Integer;
6701 begin
6702   // Check Texture Size
6703   if (TestTextureSize) then begin
6704     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
6705
6706     if ((Height > TexSize) or (Width > TexSize)) then
6707       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
6708
6709     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
6710       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
6711   end;
6712
6713   // create Texture
6714   if ID = 0 then begin
6715     CreateID;
6716     SetupParameters(BuildWithGlu);
6717   end;
6718
6719   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
6720
6721   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
6722 end;
6723
6724
6725 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
6726 begin
6727   Assert(False, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
6728 end;
6729
6730
6731 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
6732   DisableTextureUnit: Boolean);
6733 begin
6734   inherited Unbind (DisableTextureUnit);
6735
6736   if DisableTexCoordsGen then begin
6737     glDisable(GL_TEXTURE_GEN_S);
6738     glDisable(GL_TEXTURE_GEN_T);
6739     glDisable(GL_TEXTURE_GEN_R);
6740   end;
6741 end;
6742
6743
6744 { TglBitmapNormalMap }
6745
6746 type
6747   TVec = Array[0..2] of Single;
6748   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6749
6750   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
6751   TglBitmapNormalMapRec = record
6752     HalfSize : Integer;
6753     Func: TglBitmapNormalMapGetVectorFunc;
6754   end;
6755
6756
6757 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6758 begin
6759   Vec[0] := HalfSize;
6760   Vec[1] := - (Position.Y + 0.5 - HalfSize);
6761   Vec[2] := - (Position.X + 0.5 - HalfSize);
6762 end;
6763
6764
6765 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6766 begin
6767   Vec[0] := - HalfSize;
6768   Vec[1] := - (Position.Y + 0.5 - HalfSize);
6769   Vec[2] := Position.X + 0.5 - HalfSize;
6770 end;
6771
6772
6773 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6774 begin
6775   Vec[0] := Position.X + 0.5 - HalfSize;
6776   Vec[1] := HalfSize;
6777   Vec[2] := Position.Y + 0.5 - HalfSize;
6778 end;
6779
6780
6781 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6782 begin
6783   Vec[0] := Position.X + 0.5 - HalfSize;
6784   Vec[1] := - HalfSize;
6785   Vec[2] := - (Position.Y + 0.5 - HalfSize);
6786 end;
6787
6788
6789 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6790 begin
6791   Vec[0] := Position.X + 0.5 - HalfSize;
6792   Vec[1] := - (Position.Y + 0.5 - HalfSize);
6793   Vec[2] := HalfSize;
6794 end;
6795
6796
6797 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6798 begin
6799   Vec[0] := - (Position.X + 0.5 - HalfSize);
6800   Vec[1] := - (Position.Y + 0.5 - HalfSize);
6801   Vec[2] := - HalfSize;
6802 end;
6803
6804
6805 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
6806 var
6807   Vec : TVec;
6808   Len: Single;
6809 begin
6810   with FuncRec do begin
6811     with PglBitmapNormalMapRec (CustomData)^ do begin
6812       Func(Vec, Position, HalfSize);
6813
6814       // Normalize
6815       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
6816       if Len <> 0 then begin
6817         Vec[0] := Vec[0] * Len;
6818         Vec[1] := Vec[1] * Len;
6819         Vec[2] := Vec[2] * Len;
6820       end;
6821
6822       // Scale Vector and AddVectro
6823       Vec[0] := Vec[0] * 0.5 + 0.5;
6824       Vec[1] := Vec[1] * 0.5 + 0.5;
6825       Vec[2] := Vec[2] * 0.5 + 0.5;
6826     end;
6827
6828     // Set Color
6829     Dest.Red   := Round(Vec[0] * 255);
6830     Dest.Green := Round(Vec[1] * 255);
6831     Dest.Blue  := Round(Vec[2] * 255);
6832   end;
6833 end;
6834
6835
6836 procedure TglBitmapNormalMap.AfterConstruction;
6837 begin
6838   inherited;
6839
6840   fGenMode := GL_NORMAL_MAP;
6841 end;
6842
6843
6844 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
6845   TestTextureSize: Boolean);
6846 var
6847   Rec: TglBitmapNormalMapRec;
6848   SizeRec: TglBitmapPixelPosition;
6849 begin
6850   Rec.HalfSize := Size div 2;
6851
6852   FreeDataAfterGenTexture := False;
6853
6854   SizeRec.Fields := [ffX, ffY];
6855   SizeRec.X := Size;
6856   SizeRec.Y := Size;
6857
6858   // Positive X
6859   Rec.Func := glBitmapNormalMapPosX;
6860   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6861   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
6862
6863   // Negative X
6864   Rec.Func := glBitmapNormalMapNegX;
6865   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6866   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
6867
6868   // Positive Y
6869   Rec.Func := glBitmapNormalMapPosY;
6870   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6871   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
6872
6873   // Negative Y
6874   Rec.Func := glBitmapNormalMapNegY;
6875   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6876   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
6877
6878   // Positive Z
6879   Rec.Func := glBitmapNormalMapPosZ;
6880   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6881   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
6882
6883   // Negative Z
6884   Rec.Func := glBitmapNormalMapNegZ;
6885   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6886   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
6887 end;
6888
6889 initialization
6890   glBitmapSetDefaultFormat(tfEmpty);
6891   glBitmapSetDefaultMipmap(mmMipmap);
6892   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
6893   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
6894
6895   glBitmapSetDefaultFreeDataAfterGenTexture(true);
6896   glBitmapSetDefaultDeleteTextureOnFree    (true);
6897
6898 finalization
6899
6900 end.