glBitmap.pas

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