Apus.Engine.ResManGL.pas

// OpenGL-based texture classes and texture manager
//
// Copyright (C) 2011 Ivan Polyacov, Apus Software (ivan@apus-software.com)
// This file is licensed under the terms of BSD-3 license (see license.txt)
// This file is a part of the Apus Game Engine (http://apus-software.com/engine/)

{$I defines.inc}
unit Apus.Engine.ResManGL;
interface
 uses Apus.Engine.API, Apus.Images, Apus.Core, Types, Apus.Engine.Resources, Apus.Threads, SyncObjs;
const
 // Texture unit layout. Every GL target has 32 units at least (GLES 3.0: 32, GL 3.3: 48).
 // Units below the scratch one are bound only by BindToUnit (from the shaders API), so the
 // bound-texture cache and the shaders API always agree on what a unit holds
 TEX_USER_UNITS     = 16; // stages 0..15 of IShader.UseTexture
 TEX_UNIT_SHADOWMAP = 16; // 16..19 - shadow maps
 TEX_UNIT_NORMALMAP = 20;
 TEX_UNIT_SCRATCH   = 31; // uploads, texture parameters, readback: never sampled
type
 // OpenGL texture object with CPU-side storage and upload/sync helpers.
 // Managed by TGLResourceManager, can also represent RT/depth/array layers.
 // OpenGL texture
 TGLTexture=class(TTexture)
 const
  MAX_LEVEL = 5;  // maximal number of supported mip level [0..MAX_LEVEL]
 var
  texname:cardinal;
  realWidth,realHeight:integer; // real dimensions of underlying texture object (can be larger than requested)
  filter:TTexFilter;
  constructor Create;
  procedure Clear(color:cardinal=$808080); override;
  destructor Destroy; override;
  procedure ClearPart(mipLevel:byte;x,y,width,height:integer;color:cardinal); override;
  procedure CloneFrom(src:TTexture); override;
  procedure MakeImmutable; override;
  procedure PrepareContentExchange(donor:TTexture); override;
  procedure ExchangeContent(donor:TTexture); override;
  procedure SetAsRenderTarget; virtual;
  procedure Lock(miplevel:byte=0;mode:TlockMode=lmReadWrite;r:PRect=nil); override; // level 0 is the top one
  procedure AddDirtyRect(rect:TRect;level:integer); override;
  procedure GenerateMipMaps(count:byte); override;
  procedure Unlock; override;
  function GetRawImage:TRawImage; override; // create a RAW image and assign it to the top texture level (only while the texture is locked!!!)
  function Describe:string;
  procedure SetFilter(filter:TTexFilter); override;
  procedure Dump(filename:string8=''); override;
  function GetLayer(layer:integer):TTexture; override;
  procedure LockLayer(index:integer;miplevel:byte=0;mode:TLockMode=lmReadWrite;r:PRect=nil); override;
  // Direct upload - destroys internal storage
  procedure Upload(pixelData:pointer;pitch:integer;pixelFormat:TImagePixelFormat); override;
  procedure Upload(mipLevel:byte;pixelData:pointer;pitch:integer;pixelFormat:TImagePixelFormat); override;
  procedure UploadPart(mipLevel:byte;x,y,width,height:integer;pixelData:pointer;pitch:integer;pixelFormat:TImagePixelFormat); override;

 protected
 type
  TUploadRequest=record
   data:pointer;
   pitch:integer;
   mipLevel:integer;
   pf:TImagePixelFormat;
   x,y,width,height:integer;
  end;
 var
  // Storage fields (GL object, CPU copy, upload state) are swapped by ExchangeContent:
  // a new one must be added there too
  cs:TCriticalSection;
  // RW-lock for multi-window access to shared mutable textures.
  // OS-assisted (SRWLock on Windows, pthread_rwlock_t on Linux) — no busy-wait.
  // Only used when NeedSyncForRead/Write returns true (multiWindowMode=true).
  rwLock:TRWLock;
  ownerThread:TThreadIdent; // for tfThreadLocal: thread that owns this texture (debug checks)
  online:boolean; // true when image data is uploaded and ready to use (uv's are valid), false when local image data was modified and should be uploaded
  realData:array[0..MAX_LEVEL] of ByteArray; // internal storage of texture data
  fbo:cardinal; // framebuffer object (for a render target texture)
  rbo:cardinal; // renderbuffer object - for a render target texture with a depth buffer attached (but not for depth buffer textures)
  // Define area of the internal storage which is recently updated and need to be uploaded
  dirty:array[0..MAX_LEVEL,0..15] of TRect;
  dCount:array[0..MAX_LEVEL] of integer; // per each mip level
  // Which levels of internal storage are obsolete
  realDataObsolete:array[0..MAX_LEVEL] of boolean;
  // upload request
  uploadRequest:TUploadRequest;
  // RW-lock protocol: acquire before modifying texture data, release after
  procedure BeginRead; // shared read lock (many concurrent readers allowed)
  procedure EndRead;
  procedure BeginWrite; // exclusive write lock (blocks until all readers done)
  procedure EndWrite;
  procedure ForgetBindings; override;
  procedure SetLabel; // submit name as label for OpenGL
  procedure UpdateFilter;
  procedure InitStorage; virtual; // allocate GL texture object (if needed)
  procedure UploadInternalData; virtual; // upload modified internal storage data (using dirty rects)
  procedure FreeData; virtual;
  procedure Bind; virtual; // to the active unit
  procedure BindScratch; // to the scratch unit: for work on the texture, not for sampling
  function IsBound(stage:integer):boolean; virtual;
  function GetTextureTarget:integer; virtual;
  procedure InvalidateInternalLevel(mipLevel:integer); virtual;
  // Download texture data into the internal storage
  procedure DownloadLevel(mipLevel:integer); virtual;
  procedure ProcessUploadRequest; virtual;
  procedure EnsureWritable(opName:string8); inline;
  procedure EnsureNotCompressed(opName:string8);
 end;

 // OpenGL-backed vertex buffer wrapper.
 // Created/freed by TGLResourceManager and used by renderDevice.
 TVertexBufferGL=class(TVertexBuffer)
  procedure Upload(fromVertex,numVertices:integer;vertexData:pointer); override;
  destructor Destroy; override;
  procedure Resize(newCount:integer); override;
  procedure PublishUpdate; override;
  procedure WaitForPublish; override;
  procedure ResetPublishState; override;
 protected
  buffer:cardinal;
  usage:cardinal;
  publishedSync:pointer;
 end;

 // OpenGL-backed index buffer wrapper.
 // Created/freed by TGLResourceManager and used by renderDevice.
 TIndexBufferGL=class(TIndexBuffer)
  procedure Upload(fromIndex,numIndices:integer;indexData:pointer); override;
  destructor Destroy; override;
  procedure Resize(newCount:integer); override;
  procedure PublishUpdate; override;
  procedure WaitForPublish; override;
  procedure ResetPublishState; override;
 protected
  buffer:cardinal;
  usage:cardinal;
  publishedSync:pointer;
 end;

 // Texture array/3D-texture adapter over TGLTexture.
 // Exposes per-layer lock/upload while sharing one GL object.
 // Used for both 2D texture arrays and 3D textures
 TGLTextureArray=class(TGLTexture)
  constructor Create(numLayers:integer);
  procedure MakeImmutable; override;
  function GetLayer(layer:integer):TTexture; override;
  procedure LockLayer(index:integer;miplevel:byte=0;mode:TLockMode=lmReadWrite;r:PRect=nil); override;
  procedure Lock(miplevel:byte=0;mode:TLockMode=lmReadWrite;r:PRect=nil); overload; override; // treat mip level as array index for convenience
  procedure AddDirtyRect(index:integer;rect:TRect); overload; virtual;
  procedure Unlock; override;
  procedure Dump(filename:string8=''); override;
 protected
  layers:array of TGLTexture; // fake texture objects used to
  lockedLayer:integer;
  procedure FreeData; override;
  procedure UploadInternalData; override;
  function GetTextureTarget:integer; override;
 end;

 // Central OpenGL resource owner: textures, buffers, RT attachments.
 // Implements IResourceManager and owns most GL objects (textures, FBO/RBO, VBO/IBO).
 // Must be shut down while GL context is still current.
 TGLResourceManager=class(TInterfacedObject,IResourceManager)
  maxTextureSize,maxRTsize,maxRBsize:integer;

  constructor Create;
  destructor Destroy; override;

  function AllocImage(width,height:integer;PixFmt:TImagePixelFormat;
                flags:cardinal;name:String8):TTexture; overload;
  function AllocImage(width,height,mipLevels:integer;PixFmt:TImagePixelFormat;
     flags:cardinal;name:String8):TTexture; overload;
  procedure ResizeImage(var img:TTexture;newWidth,newHeight:integer);
  procedure AttachDepthBuffer(tex:TTexture;dBuf:TTexture);
  procedure FreeImage(var image:TTexture);


  // Allocate texture array
  function AllocArray(width,height:integer;PixFmt:TImagePixelFormat;
                arraySize:integer;flags:cardinal;name:String8):TGLTextureArray;

  procedure MakeOnline(img:TTexture);
  // Upload and bind for sampling: only the shaders API binds units below TEX_UNIT_SCRATCH
  procedure BindToUnit(img:TTexture;texUnit:integer);
  procedure SetTexFilter(img:TTexture;filter:TTexFilter);

  function QueryParams(width,height:integer;format:TImagePixelFormat;usage:integer):boolean;

  // Helper functions (for debugging/getting info)
  function GetStatus(line:byte):string; // build status lines

  // Create a dump of video memory usage and allocation
  procedure Dump(st:string='');

  // Data buffers
  function AllocVertexBuffer(layout:TVertexLayout;numVertices:integer;
    usage:TBufferUsage=buStatic;flags:cardinal=0):TVertexBuffer;
  function AllocRawVertexBuffer(strideBytes,numVertices:integer;
    usage:TBufferUsage=buStatic;flags:cardinal=0):TVertexBuffer;
  procedure UseVertexBuffer(vb:TVertexBuffer);
  function AllocIndexBuffer(indCount:integer;elementSize:integer=2;
    usage:TBufferUsage=buStatic;flags:cardinal=0):TIndexBuffer;
  procedure UseIndexBuffer(ib:TIndexBuffer);
  procedure FreeBuffer(buf:TEngineBuffer);

 protected
  //CurTag:integer;
  //data:TObject;
  //texFilters:array[0..15] of TTexFilter;
  procedure FreeVidMem; // free some amount of video memory
  procedure FreeMetaTexSpace(n:integer); // free some space in the given metatexture
  procedure AllocRenderTarget(tex:TGLTexture;flags:cardinal);
 end;

 var
  resourceManagerGL:TGLResourceManager;
  // Max anisotropy for textures with the fltAnisotropic filter, clamped to the GPU limit.
  // Takes effect when a texture filter is set. Without anisotropic filtering support
  // (GL 4.6, ARB/EXT_texture_filter_anisotropic) fltAnisotropic works as fltTrilinear.
  anisotropyLevel:single=8;

 type
  // Optional features above the GL 3.3 / ES 3.0 baseline, each with a baseline fallback.
  // Detected by the context version first, by the extension second
  TGLFeatures=record
   dsa:boolean;          // direct state access (GL 4.5, ARB_direct_state_access)
   clearTexture:boolean; // glClearTexImage/glClearTexSubImage (GL 4.4, ARB_clear_texture)
  end;
 var
  // May be changed at run time (tests check both paths in one process)
  glFeatures:TGLFeatures;

 // baseline=true turns all features off (TGLContextRequest.baseline, -GLBASELINE)
 procedure DetectGLFeatures(baseline:boolean);

 // Load image from file (TGA or JPG), result is expected in given pixel format or source pixel format
// function LoadFromFile(filename:string;format:TImagePixelFormat=ipfNone):TDxManagedTexture;

 {$IFDEF GLES}
 // GLES has no reliable BGRA texture/readback format: swap R/B on CPU instead.
 // Shared with Apus.Engine.OpenGL (backbuffer readback).
 procedure SwapRedBlue8888(data:pointer;pixelCount:integer);
 {$ENDIF}

implementation
 uses Apus.EventMan, Apus.Lib, SysUtils, TypInfo, Apus.GfxFormats, Apus.Engine.ShadersGL,
   {$IFDEF GLDESKTOP}dglOpenGL{$ENDIF}
   {$IFDEF GLES}dglOpenGLES{$ENDIF}
   ,
  Apus.Classes,
  Apus.Conv,
  Apus.Engine.RobotAPI,
  Apus.Files,
  Apus.Engine.Graphics,
  Apus.Log;

{ How it works: whenever possible, textures are created as plain
  memory data buffers. On MakeOnline the data is transferred
  into GL textures. This usually happens right before drawing
  (and in the render thread), thus avoiding multithreading issues.
}

const
 // depth renderbuffers of render targets: sized format, same before and after a resize (ES 3.0 requires a sized one)
 DEPTH_RB_FORMAT = GL_DEPTH_COMPONENT24;

var
 mainThreadId:TThreadIdent;
 cSect:TLock; // TODO: why? There is no global data that needs protection
 lastErrorTime:int64;
 errorTr:integer;

 maxAnisotropy:single=-1; // GPU limit for GL_TEXTURE_MAX_ANISOTROPY: 0 - not supported, -1 - not queried yet
 activeTex:integer; // currently active texture unit
 boundTex2D:array[0..TEX_UNIT_SCRATCH] of TTexture; // current texture bound
 boundTex3D:array[0..TEX_UNIT_SCRATCH] of TTexture;
 boundTex2D_Arr:array[0..TEX_UNIT_SCRATCH] of TTexture;

{$REGION UTILS}
function InMainThread:boolean; inline;
begin
 result:=GetCurrentThreadID=mainThreadID;
end;

procedure TrackArrayBufferBinding(buffer:cardinal); inline;
 var
  tracker:IRenderDeviceBindTracking;
 begin
  if (renderDevice<>nil) and Supports(renderDevice,IRenderDeviceBindTracking,tracker) then
   tracker.TrackArrayBufferBinding(buffer);
 end;

procedure TrackElementBufferBinding(buffer:cardinal); inline;
 var
  tracker:IRenderDeviceBindTracking;
 begin
  if (renderDevice<>nil) and Supports(renderDevice,IRenderDeviceBindTracking,tracker) then
   tracker.TrackElementBufferBinding(buffer);
 end;

procedure SetGLObjectLabel(identifier,name:cardinal;const labelText:String8); inline;
begin
 // Stage 7: labeling is best-effort, never required for rendering correctness.
 {$IFDEF GLES}
 // Core glObjectLabel doesn't exist in ES 3.0; only the GL_KHR_debug extension form does.
 if (name<>0) and (labelText<>'') and (@glObjectLabelKHR<>nil) then
  glObjectLabelKHR(identifier,name,length(labelText),@labelText[1]);
 {$ELSE}
 if (name<>0) and (labelText<>'') and (@glObjectLabel<>nil) then
  glObjectLabel(identifier,name,length(labelText),@labelText[1]);
 {$ENDIF}
end;

function ShortGLLabel(const preferred,prefix:String8;id:cardinal;maxLen:integer=12):String8; inline;
 begin
  if preferred<>'' then
   result:=preferred
  else
   result:=prefix+IntToStr(id);
  if length(result)>maxLen then
   result:=copy(result,1,maxLen);
 end;

function BuildVBLabel(vb:TVertexBufferGL):String8; inline;
 begin
  result:=ShortGLLabel(vb.debugName,'vb',vb.buffer,12);
 end;

function BuildIBLabel(ib:TIndexBufferGL):String8; inline;
 begin
  result:=ShortGLLabel(ib.debugName,'ib',ib.buffer,12);
 end;


procedure ActiveTextureUnit(u:integer);
 begin
  ASSERT((u>=0) and (u<=TEX_UNIT_SCRATCH));
  glActiveTexture(GL_TEXTURE0+u);
  activeTex:=u;
 end;

procedure UnbindTex(tex:TTexture);
 var
  i:integer;
 begin
  for i:=0 to high(boundTex2D) do
   if boundTex2D[i]=tex then boundTex2D[i]:=nil;
  for i:=0 to high(boundTex3D) do
   if boundTex3D[i]=tex then boundTex3D[i]:=nil;
  for i:=0 to high(boundTex2D_Arr) do
   if boundTex2D_Arr[i]=tex then boundTex2D_Arr[i]:=nil;
 end;

procedure DetectGLFeatures(baseline:boolean);
 begin
  Mem.Clear(glFeatures,sizeof(glFeatures));
  {$IFDEF GLDESKTOP}
  if not baseline then begin
   glFeatures.dsa:=(GL_VERSION_4_5 or GL_ARB_direct_state_access) and (@glTextureSubImage2D<>nil);
   glFeatures.clearTexture:=(GL_VERSION_4_4 or GL_ARB_clear_texture) and (@glClearTexSubImage<>nil);
  end;
  {$ENDIF}
  Log.Force('GL features: DSA=%s, clear texture=%s%s',[BoolToStr(glFeatures.dsa,true),
   BoolToStr(glFeatures.clearTexture,true),IfThen(baseline,' (baseline only)','')]);
 end;

procedure CheckForGLError(msg:string); //inline;
var
 error:cardinal;
 t:int64;
begin
 error:=glGetError;
 if error<>GL_NO_ERROR then {try
  t:=CoreTime.Ticks;
  if t<lastErrorTime+1000 then inc(errorTr)
   else errorTr:=0;
  if errorTr<5 then begin
   lastErrorTime:=t;
   Log.Force('GLI Error ('+msg+') '+inttostr(error)+' '+GetCallStack);
  end else}
   raise EError.Create('GLI Error ('+msg+') '+inttostr(error));
{ except
 end;}
end;

{$IFDEF GLES}
// glGetTexImage doesn't exist in GLES: read back through a scratch FBO instead.
// Unoptimized (allocates/frees an FBO per call) - only used by Dump/DownloadLevel debug paths.
procedure GLESReadTexImage(target:cardinal;texName:cardinal;level:integer;width,height:integer;
   format,dataType:cardinal;dest:pointer;layer:integer=0);
 var
  fbo:cardinal;
  prevFBO:integer;
 begin
  glGetIntegerv(GL_FRAMEBUFFER_BINDING,@prevFBO); // don't disturb the render-target state tracking
  glGenFramebuffers(1,@fbo);
  glBindFramebuffer(GL_FRAMEBUFFER,fbo);
  if (target=GL_TEXTURE_2D_ARRAY) or (target=GL_TEXTURE_3D) then
   glFramebufferTextureLayer(GL_FRAMEBUFFER,GL_COLOR_ATTACHMENT0,texName,level,layer)
  else
   glFramebufferTexture2D(GL_FRAMEBUFFER,GL_COLOR_ATTACHMENT0,target,texName,level);
  glReadPixels(0,0,width,height,format,dataType,dest);
  glBindFramebuffer(GL_FRAMEBUFFER,cardinal(prevFBO));
  glDeleteFramebuffers(1,@fbo);
 end;

// GLES has no reliable BGRA readback format: read as RGBA then swap R/B on CPU.
procedure SwapRedBlue8888(data:pointer;pixelCount:integer);
 var
  p:PByteArray;
  i:integer;
  b:byte;
 begin
  p:=data;
  for i:=0 to pixelCount-1 do begin
   b:=p[i*4];
   p[i*4]:=p[i*4+2];
   p[i*4+2]:=b;
  end;
 end;

// ipfARGB/ipfXRGB source data is B,G,R,A in memory but uploaded as GL_RGBA under
// GLES (no BGRA texture format there): swap into a scratch copy before upload.
// TODO: swizzle - use GL_TEXTURE_SWIZZLE_* instead of a per-upload CPU copy where supported.
function BGRAToRGBACopy(src:pointer;pixelCount:integer):pointer;
 begin
  GetMem(result,pixelCount*4);
  Move(src^,result^,pixelCount*4);
  SwapRedBlue8888(result,pixelCount);
 end;
{$ENDIF}

const
 // Block-compressed formats: pixelSize[] holds the size of a 4x4 block, and the data
 // can only be uploaded a whole level at a time (glCompressedTexImage2D)
 DXTformats = [ipfDXT1,ipfDXT2,ipfDXT3,ipfDXT5];
 compressedFormats = DXTformats+[ipfPVRTC];

// Pitch and size of the internal storage for one mip level of the given dimensions
procedure GetLevelSize(ipf:TImagePixelFormat;width,height:integer;out pitch,size:integer);
 begin
  if ipf in DXTformats then begin // dimensions are counted in 4x4 blocks
   pitch:=((width+3) div 4)*pixelSize[ipf] div 8;
   size:=pitch*((height+3) div 4);
  end else begin // PVRTC is 4 bpp with a linear layout, just like the uncompressed formats
   pitch:=width*pixelSize[ipf] div 8;
   size:=pitch*height;
  end;
 end;

// S3TC is an extension even on desktop GL: without it the driver rejects the internal format
function CompressedFormatSupported(ipf:TImagePixelFormat):boolean;
 begin
  {$IFDEF GLDESKTOP}
  if ipf in DXTformats then exit(GL_EXT_texture_compression_s3tc);
  {$ENDIF}
  result:=true; // anything else is rejected by GetGLformat anyway
 end;

procedure GetGLformat(ipf:TImagePixelFormat;out format,dataType,internalFormat:cardinal);
begin
 case ipf of
  {$IFNDEF GLES}
  ipf8Bit:begin
   internalFormat:=4;
   format:=GL_COLOR_INDEX;
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipfRGB:begin
   internalFormat:=GL_RGB8;
   format:=GL_BGR;
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipfARGB:begin
   internalFormat:=GL_RGBA8;
   format:=GL_BGRA;
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipfXRGB:begin
   internalFormat:=GL_RGB8;
   format:=GL_BGRA;
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipfMono8:begin
   internalFormat:=GL_R8;
   format:=GL_RED;
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipfMono8u:begin
   internalFormat:=GL_R8UI;
   format:=GL_RED_INTEGER;
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipfMono16:begin
   internalFormat:=GL_R16;
   format:=GL_RED;
   dataType:=GL_UNSIGNED_SHORT;
  end;
  ipfMono16s:begin
   internalFormat:=GL_R16_SNORM;
   format:=GL_RED;
   dataType:=GL_SHORT;
  end;
  ipfMono16i:begin
   internalFormat:=GL_R16I;
   format:=GL_RED_INTEGER;
   dataType:=GL_SHORT;
  end;
  ipfMono32f:begin
   internalFormat:=GL_R32F;
   format:=GL_RED;
   dataType:=GL_FLOAT;
  end;
  ipfDuo32f:begin
   internalFormat:=GL_RG32F;
   format:=GL_RG;
   dataType:=GL_FLOAT;
  end;
  ipfQuad32f:begin
   internalFormat:=GL_RGBA32F;
   format:=GL_RGBA;
   dataType:=GL_FLOAT;
  end;
  ipfDuo8:begin
   internalFormat:=GL_RG8;
   format:=GL_RG;
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipf565:begin
   internalFormat:=GL_RGB5;
   format:=GL_RGB;
   dataType:=GL_UNSIGNED_SHORT_5_6_5;
  end;
  ipf1555:begin
   internalFormat:=GL_RGB5_A1;
   format:=GL_RGBA;
   dataType:=GL_UNSIGNED_SHORT_5_5_5_1;
  end;
  ipf4444:begin
   internalFormat:=GL_RGBA4;
   format:=GL_RGBA;
   dataType:=GL_UNSIGNED_SHORT_4_4_4_4_REV;
  end;
  ipf4444r:begin
   internalFormat:=GL_RGBA4;
   format:=GL_RGBA;
   dataType:=GL_UNSIGNED_SHORT_4_4_4_4;
  end;
  ipfDXT1:begin
   internalFormat:=GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
   format:=internalFormat;  // not used: compressed data is uploaded with glCompressedTexImage2D
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipfDXT3:begin
   internalFormat:=GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
   format:=internalFormat;  // not used: compressed data is uploaded with glCompressedTexImage2D
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipfDXT5:begin
   internalFormat:=GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
   format:=internalFormat;  // not used: compressed data is uploaded with glCompressedTexImage2D
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipfA4:begin
   internalFormat:=GL_ALPHA4;
   format:=GL_ALPHA;
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipfL4A4:begin
   internalFormat:=GL_LUMINANCE4_ALPHA4;
   format:=GL_LUMINANCE_ALPHA;
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipfA8:begin
   internalFormat:=GL_ALPHA8;
   format:=GL_ALPHA;
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipfDepth32f:begin
   internalFormat:=GL_DEPTH_COMPONENT;
   format:=GL_DEPTH_COMPONENT;
   dataType:=GL_FLOAT;
  end;
  {$ENDIF}
  {$IFDEF GLES}
  // BGRA/ARGB pixel data is converted to RGBA on the CPU at upload/readback
  // (see UploadPixelData/ReadPixelData) - GLES has no reliable BGRA texture
  // format, so internalFormat/format here are always plain sized RGBA.
  // TODO: swizzle - use a texture swizzle mask instead of a CPU copy where the driver supports it.
  ipfARGB,ipfXRGB:begin
   internalFormat:=GL_RGBA8;
   format:=GL_RGBA;
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipfRGB:begin
   internalFormat:=GL_RGB8;
   format:=GL_RGB;
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipf565:begin
   internalFormat:=GL_RGB565;
   format:=GL_RGB;
   dataType:=GL_UNSIGNED_SHORT_5_6_5;
  end;
  ipf1555:begin
   internalFormat:=GL_RGB5_A1;
   format:=GL_RGBA;
   dataType:=GL_UNSIGNED_SHORT_5_5_5_1;
  end;
  ipf4444,ipf4444r:begin
   internalFormat:=GL_RGBA4;
   format:=GL_RGBA;
   dataType:=GL_UNSIGNED_SHORT_4_4_4_4;
  end;
  ipfPVRTC:begin
   internalFormat:=GL_COMPRESSED_RGBA_PVRTC_4BPPV1_IMG;
   format:=internalFormat;  // not used: compressed data is uploaded with glCompressedTexImage2D
   dataType:=GL_UNSIGNED_BYTE;
  end;
  ipfA8:begin
   internalFormat:=GL_R8;
   format:=GL_RED;
   dataType:=GL_UNSIGNED_BYTE;
  end;
  {$ENDIF}
  else
   raise EError.Create('Unsupported pixel format: '+PixFmt2Str(ipf));
 end;
end;
{$ENDREGION}

{ TGLTextureArray }
{$REGION TextureArray}
procedure TGLTextureArray.AddDirtyRect(index:integer;rect:TRect);
begin
 NotImplemented;
end;

constructor TGLTextureArray.Create(numLayers: integer);
var
 i:integer;
begin
 inherited Create;
 SetLength(layers,numLayers);
 for i:=0 to numLayers-1 do
  layers[i]:=TGLTexture.Create;
end;

procedure TGLTextureArray.MakeImmutable;
var
 i:integer;
begin
 for i:=0 to high(layers) do
  if layers[i]<>nil then
   layers[i].MakeImmutable;
 inherited;
end;


procedure TGLTextureArray.Dump(filename:string8);
var
 layer,itemSize:integer;
 texData,data:ByteArray;
 image:TRawImage;
begin
 if filename='' then filename:='tex_'+name+'_';
 if texname=0 then begin
   Files.Save(filename+'.tex','Not allocated');
   exit;
  end;
 BindScratch;
 itemSize:=width*height*4;
 SetLength(texData,itemSize*length(layers));
 {$IFDEF GLES}
 // One scratch FBO alloc/free per array layer - debug-dump-only path, unoptimized is fine here.
 for layer:=0 to high(layers) do
  GLESReadTexImage(GetTextureTarget,texname,0,width,height,GL_RGBA,GL_UNSIGNED_BYTE,@texData[itemSize*layer],layer);
 SwapRedBlue8888(@texData[0],width*height*length(layers));
 {$ELSE}
 glGetTexImage(GetTextureTarget,0,GL_BGRA,GL_UNSIGNED_INT_8_8_8_8_REV,@texData[0]);
 {$ENDIF}
 image:=TBitmapImage.Create(width,height,ipfARGB);
 for layer:=0 to high(layers) do begin
  image.data:=@texData[itemSize*layer];
  image.data:=@(layers[layer].realData[0,0]);
  data:=SavePNG(image);
  Files.Save(filename+inttostr(layer)+'.png',data);
 end;
 image.Free;
end;

procedure TGLTextureArray.FreeData;
begin
 inherited;
end;

function TGLTextureArray.GetLayer(layer:integer):TTexture;
begin
 ASSERT((layer>=0) and (layer<=high(layers)));
 result:=layers[layer];
end;

function TGLTextureArray.GetTextureTarget:integer;
begin
 if HasFlag(tfTexture) then
  result:=GL_TEXTURE_3D
 else
  result:=GL_TEXTURE_2D_ARRAY;
end;

procedure TGLTextureArray.LockLayer(index:integer; miplevel:byte; mode:TlockMode; r:PRect);
begin
 inc(locked);
 layers[index].Lock(mipLevel,mode,r);
 data:=layers[index].data;
 pitch:=layers[index].pitch;
 lockedLayer:=index;
 online:=false;
 Bits.SetFlag(caps,tfDirty);
end;

procedure TGLTextureArray.Lock(miplevel:byte=0;mode:TlockMode=lmReadWrite;r:PRect=nil);
begin
 raise EError.Create('Use LockLayer instead');
end;

procedure TGLTextureArray.Unlock;
begin
 layers[lockedLayer].Unlock;
 dec(locked);
end;

procedure TGLTextureArray.UploadInternalData;
var
 needInit:boolean;
 format,subformat,internalFormat,error:cardinal;
 i,bpp,z,depth,level:integer;
 glTarget:integer;
begin
  needInit:=false;
  if locked>0 then raise EWarning.Create('MO for a locked texture: '+name);

  if texname=0 then begin // allocate texture name
   glGenTextures(1,@texname);
   CheckForGLError('11');
   needInit:=true;
  end;
  BindScratch;
  if needInit then begin
   SetLabel;
   CheckForGLError('12');
  end;

  // Upload texture data
  glTarget:=GetTextureTarget;
  GetGLFormat(PixelFormat,format,subFormat,internalFormat);
  depth:=length(layers);
  if pixelFormat in compressedFormats then begin
   for z:=0 to depth-1 do
    for level:=0 to MAX_LEVEL do
     if length(realData[level])>0 then
      glCompressedTexImage3D(glTarget,level,internalFormat,realwidth,realheight,depth,0,
       length(layers[z].realData[level]),@realData[level,0]);
  end else begin
   if needInit then begin  // Specify texture size and pixel format
    glTexImage3D(glTarget,0,internalFormat,realwidth,realheight,depth,0,
      format,subFormat,nil);
    CheckForGLError('13');
    UpdateFilter;
   end;
    // Upload texture data. ES 3.0 supports GL_UNPACK_ROW_LENGTH same as desktop GL.
    glPixelStorei(GL_UNPACK_ROW_LENGTH,realWidth);
    CheckForGLError('14');
    bpp:=pixelSize[pixelFormat] div 8;
    for z:=0 to depth-1 do
     with layers[z] do
      for level:=0 to MAX_LEVEL do begin
       for i:=0 to dCount[level]-1 do
        with dirty[level,i] do
         glTexSubImage3D(glTarget,level,Left,Top,z,right-left+1,bottom-top+1,1,
            format,subFormat,@realData[level,(left+top*realWidth)*bpp]);
       dCount[level]:=0;
      end;
    CheckForGLError('15');
   {$IFDEF GLES}
   if HasFlag(tfAutoMipMap) then begin // core in ES 3.0
   {$ELSE}
   if HasFlag(tfAutoMipMap) and (GL_VERSION_3_0 or GL_ARB_framebuffer_object) then begin
   {$ENDIF}
    glGenerateMipmap(glTarget);
   end;

   if HasFlag(tfClamped) then begin
    glTexParameteri(glTarget,GL_TEXTURE_WRAP_S,GL_CLAMP_TO_EDGE);
    glTexParameteri(glTarget,GL_TEXTURE_WRAP_T,GL_CLAMP_TO_EDGE);
   end else begin
    glTexParameteri(glTarget,GL_TEXTURE_WRAP_S,GL_REPEAT);
    glTexParameteri(glTarget,GL_TEXTURE_WRAP_T,GL_REPEAT);
   end;
   CheckForGLError('17');
  end;
  online:=true;
  Bits.Clear(caps,tfDirty);
end;
{$ENDREGION}

{ TGLTexture }
{$REGION Texture}
procedure TGLTexture.Bind;
var
 target:integer;
begin
 target:=GetTextureTarget;
 glBindTexture(target,texname);
 CheckForGLError('211');
 case target of
  GL_TEXTURE_2D:boundTex2D[activeTex]:=self;
  GL_TEXTURE_3D:boundTex3D[activeTex]:=self;
  GL_TEXTURE_2D_ARRAY:boundTex2D_Arr[activeTex]:=self;
 end;
end;

procedure TGLTexture.BindScratch;
begin
 if activeTex<>TEX_UNIT_SCRATCH then ActiveTextureUnit(TEX_UNIT_SCRATCH);
 Bind;
end;

procedure TGLTexture.Clear(color:cardinal);
 var
  level:integer;
 begin
  EnsureWritable('Clear');
  EnsureNotCompressed('Clear');
  // glClearTexImage is GL 4.4+, not available under GLES - CPU fill fallback below.
  {$IFNDEF GLES}
  if InMainThread and glFeatures.clearTexture then begin
   cs.Enter;
   try
    InitStorage;
    // Clear directly
    for level:=0 to mipmaps do
     glClearTexImage(texName,level,GL_BGRA,GL_UNSIGNED_BYTE,@color);
    CheckForGLError('191');
    InvalidateInternalLevel(0);
   finally
     cs.Leave;
   end;
  end else
  {$ENDIF}
  begin
   // Clear in the internal storage
   Lock;
   Mem.FillD(realData[0][0],length(realData[0]) div 4,color);
   Unlock;
  end;
 end;

procedure TGLTexture.ClearPart(mipLevel:byte;x,y,width,height:integer;color:cardinal);
var
 yy:integer;
 pb:PByte;
 r:TRect;
begin
  EnsureWritable('ClearPart');
  EnsureNotCompressed('ClearPart');
  // glClearTexSubImage is GL 4.4+, not available under GLES - CPU fill fallback below.
  {$IFNDEF GLES}
  if (texName<>0) and InMainThread and glFeatures.clearTexture then begin
  // Upload remaining data if needed
  UploadInternalData;
  cs.Enter;
  try
   // Clear directly
   glClearTexSubImage(texName,mipLevel,x,y,0,width,height,1,GL_BGRA,GL_UNSIGNED_BYTE,@color);
   CheckForGLError('221');
   InvalidateInternalLevel(mipLevel);
  finally
   cs.Leave;
  end;
 end else
 {$ENDIF}
 begin
  // Clear in the internal storage
  r:=Rect(x,y,x+width-1,y+width-1);
  Lock(mipLevel,lmReadWrite,@r);
  pb:=data;
  inc(pb,y*pitch+x*4);
  for yy:=y to y+height-1 do begin
   Mem.FillD(pb^,width,color);
   inc(pb,pitch);
  end;
  Unlock;
 end;
end;

procedure TGLTexture.CloneFrom(src:TTexture);
begin
 inherited;
end;

procedure TGLTexture.PrepareContentExchange(donor:TTexture);
var
 d:TGLTexture;
begin
 if not InMainThread then raise EWarning.Create('Content exchange requires the render thread');
 if (ClassType<>TGLTexture) or (donor=nil) or (donor.ClassType<>TGLTexture) then
  raise EWarning.Create('Content exchange supports ordinary 2D textures only: '+name);
 inherited;
 d:=TGLTexture(donor);
 if (uploadRequest.data<>nil) or (d.uploadRequest.data<>nil) then
  raise EWarning.Create('Content exchange with a pending upload: '+name);
 // Everything in GL that can fail happens now, before the live texture changes: the
 // donor gets this texture's sampler mode and goes to the GPU (binding only the scratch unit)
 d.filter:=filter;
 d.UploadInternalData;
 d.UpdateFilter;
 CheckForGLError('PrepareContentExchange');
end;

procedure TGLTexture.ExchangeContent(donor:TTexture);
var
 d:TGLTexture;
 level,i,w,h:integer;
 oldData:ByteArray;
 oldDirty:TRect;
 pf:TImagePixelFormat;
 m:byte;
 c:cardinal;
 procedure SwapInt(var a,b:integer);
  var v:integer;
  begin v:=a; a:=b; b:=v; end;
 procedure SwapCard(var a,b:cardinal);
  var v:cardinal;
  begin v:=a; a:=b; b:=v; end;
 procedure SwapSingle(var a,b:single);
  var v:single;
  begin v:=a; a:=b; b:=v; end;
 procedure SwapBool(var a,b:boolean);
  var v:boolean;
  begin v:=a; a:=b; b:=v; end;
begin
 // validated by PrepareContentExchange: nothing here may fail
 ASSERT(InMainThread and (donor is TGLTexture) and (donor.parent=nil) and (parent=nil));
 d:=TGLTexture(donor);
 w:=width; h:=height;
 ForgetBindings;
 UnbindTex(d);
 if shadersAPI<>nil then shadersAPI.ForgetTexture(d);
 SwapCard(texname,d.texname);
 SwapInt(width,d.width); SwapInt(height,d.height);
 SwapInt(realWidth,d.realWidth); SwapInt(realHeight,d.realHeight);
 SwapInt(pitch,d.pitch);
 pf:=pixelFormat; pixelFormat:=d.pixelFormat; d.pixelFormat:=pf;
 m:=mipmaps; mipmaps:=d.mipmaps; d.mipmaps:=m;
 // storage flags (mip-maps, clamping...) come with the storage, object flags stay
 c:=caps;
 caps:=(caps and HANDLE_CAPS) or (d.caps and not HANDLE_CAPS);
 d.caps:=(d.caps and HANDLE_CAPS) or (c and not HANDLE_CAPS);
 SwapBool(online,d.online);
 SwapSingle(u1,d.u1); SwapSingle(v1,d.v1);
 SwapSingle(u2,d.u2); SwapSingle(v2,d.v2);
 SwapSingle(stepU,d.stepU); SwapSingle(stepV,d.stepV);
 for level:=0 to MAX_LEVEL do begin
  oldData:=realData[level]; realData[level]:=d.realData[level]; d.realData[level]:=oldData;
  SwapBool(realDataObsolete[level],d.realDataObsolete[level]);
  SwapInt(dCount[level],d.dCount[level]);
  for i:=0 to high(dirty[level]) do begin
   oldDirty:=dirty[level,i]; dirty[level,i]:=d.dirty[level,i]; d.dirty[level,i]:=oldDirty;
  end;
 end;
 RefreshViews(w,h);
end;

// The bound-texture cache and the shaders API compare objects, not GL names: after the
// storage of a root changes, neither it nor any of its views may count as bound
procedure TGLTexture.ForgetBindings;
var
 i:integer;
begin
 UnbindTex(self);
 if shadersAPI<>nil then shadersAPI.ForgetTexture(self);
 for i:=0 to high(views) do begin
  UnbindTex(views[i]);
  if shadersAPI<>nil then shadersAPI.ForgetTexture(views[i]);
 end;
end;

constructor TGLTexture.Create;
begin
 inherited;
 cs:=TCriticalSection.Create;
 rwLock.Init;
end;

destructor TGLTexture.Destroy;
var
 t:TTexture;
begin
 if texName<>0 then begin
  t:=self;
  resourceManagerGL.FreeImage(t);
 end else begin
  if uploadrequest.data<>nil then begin
   uploadrequest.data:=nil;
   CoreTime.Sleep(10);
  end;
  rwLock.Cleanup;
  FreeAndNil(cs);
  inherited;
 end;
end;

function TGLTexture.Describe: string;
begin
 if self is TGLTexture then
  result:=Format('GLTexture(%8x):%s w=%d h=%d m=%d c=%x l=%d o=%d tn=%d fbo=%d dC=%d',
    [cardinal(self),name,width,height,mipmaps,caps,byte(locked),byte(online),texname,fbo,dCount[0]])
 else
  result:='Not a GL Texture at: '+inttohex(cardinal(self),8);
end;

procedure TGLTexture.DownloadLevel(mipLevel:integer);
var
 format,dataType,internal:cardinal;
 {$IFNDEF GLES}
 buf:ByteArray;
 y,h,linePitch,realPitch,size:integer;
 procedure GetLevel(var dest:ByteArray);
  begin
   if glFeatures.dsa then
    glGetTextureImage(texname,mipLevel,format,dataType,length(dest),dest)
   else begin
    BindScratch;
    glGetTexImage(GetTextureTarget,mipLevel,format,dataType,dest);
   end;
  end;
 {$ENDIF}
begin
  if pixelFormat in compressedFormats then
   raise EWarning.Create('Reading back a compressed texture is not supported: '+name);
  GetGLformat(pixelFormat,format,dataType,internal);
  {$IFDEF GLES}
  GLESReadTexImage(GetTextureTarget,texname,mipLevel,Max(width shr mipLevel,1),Max(height shr mipLevel,1),
    format,dataType,realData[mipLevel]);
  {$ELSE}
  if (realWidth=width) and (realHeight=height) then
   GetLevel(realData[mipLevel])
  else begin
   // POT-padded storage: GL returns the whole level, keep the image part only
   GetLevelSize(pixelFormat,Max(realWidth shr mipLevel,1),Max(realHeight shr mipLevel,1),realPitch,size);
   SetLength(buf,size);
   GetLevel(buf);
   GetLevelSize(pixelFormat,Max(width shr mipLevel,1),Max(height shr mipLevel,1),linePitch,size);
   h:=Max(height shr mipLevel,1);
   for y:=0 to h-1 do
    move(buf[y*realPitch],realData[mipLevel,y*linePitch],linePitch);
  end;
  {$ENDIF}
  CheckForGLError('DownL');
  realDataObsolete[mipLevel]:=false;
  dCount[mipLevel]:=0;
end;

procedure TGLTexture.Dump(filename:string8);
var
 data:ByteArray;
 image:TRawImage;
begin
 if filename='' then filename:='tex'+name+'.png';
 if texname=0 then begin
  Files.Save(filename,'Not allocated');
  exit;
 end;
 image:=TBitmapImage.Create(width,height,ipfARGB);
 {$IFDEF GLES}
 GLESReadTexImage(GetTextureTarget,texname,0,width,height,GL_RGBA,GL_UNSIGNED_BYTE,image.data);
 SwapRedBlue8888(image.data,width*height);
 {$ELSE}
 if glFeatures.dsa then
  glGetTextureImage(texname,0,GL_BGRA,GL_UNSIGNED_INT_8_8_8_8,width*height*4,image.data)
 else begin
  BindScratch;
  glGetTexImage(GetTextureTarget,0,GL_BGRA,GL_UNSIGNED_INT_8_8_8_8,image.data);
 end;
 {$ENDIF}
 data:=SavePNG(image);
 image.Free;
 Files.Save(filename,data);
end;

procedure TGLTexture.FreeData;
begin

end;

function TGLTexture.GetLayer(layer:integer):TTexture;
begin
 result:=self;
end;

function TGLTexture.GetRawImage: TRawImage;
var
 levelPitch:integer;
begin
 result:=TRawImage.Create;
 result.width:=width;
 result.height:=height;
 result.PixelFormat:=PixelFormat;
 result.data:=data;
 result.pitch:=pitch;
 GetLevelSize(PixelFormat,width,height,levelPitch,result.dataSize); // top level: matches the reported dimensions
 result.paletteFormat:=palNone;
 result.palette:=nil;
 result.palSize:=0;
end;

function TGLTexture.GetTextureTarget: integer;
begin
 result:=GL_TEXTURE_2D;
end;

procedure TGLTexture.BeginRead;
begin
 if NeedSyncForRead(self) then rwLock.EnterRead;
end;

procedure TGLTexture.EndRead;
begin
 if NeedSyncForRead(self) then rwLock.LeaveRead;
end;

procedure TGLTexture.BeginWrite;
begin
 if NeedSyncForWrite(self) then rwLock.EnterWrite;
end;

procedure TGLTexture.EndWrite;
begin
 if NeedSyncForWrite(self) then rwLock.LeaveWrite;
end;

procedure TGLTexture.EnsureWritable(opName:string8);
begin
 if HasFlag(tfImmutable) then
  raise EWarning.Create(opName+' not allowed for immutable texture: '+name);
end;

// Pixel-oriented operations make no sense for block-compressed data
procedure TGLTexture.EnsureNotCompressed(opName:string8);
begin
 if pixelFormat in compressedFormats then
  raise EWarning.Create(opName+' is not supported for a compressed texture: '+name);
end;

procedure TGLTexture.MakeImmutable;
begin
 if IsLocked then
  raise EWarning.Create('Can''t make immutable while texture is locked: '+name);
 cs.Enter;
 try
  if uploadRequest.data<>nil then
   raise EWarning.Create('Can''t make immutable while upload request is pending: '+name);
  inherited MakeImmutable;
 finally
  cs.Leave;
 end;
end;

procedure TGLTexture.Lock(miplevel:byte=0;mode:TlockMode=lmReadWrite;r:PRect=nil);
var
 size,levelPitch:integer;
 lockRect:TRect;
 writeMode:boolean;
begin
  ASSERT(mipLevel<=MAX_LEVEL);
  if HasFlag(tfNoRead) then
    raise EWarning.Create('Can''t lock texture '+name+' for reading');
  writeMode:=mode<>lmReadOnly;
  if HasFlag(tfNoWrite) and writeMode then
    raise EWarning.Create('Can''t lock texture '+name+' for writing');
  if writeMode then
   EnsureWritable('Lock');
  {$IFDEF DEBUG}
  if HasFlag(tfThreadLocal) and (ownerThread<>0) then
   ASSERT(ownerThread=GetCurrentThreadID,
    'Thread-local texture locked from wrong thread: '+name);
  {$ENDIF}
  if locked=0 then BeginWrite; // outer lock: acquire exclusive sync (no-op in single-window mode)
  cs.Enter;
  try
   if r=nil then lockRect:=Rect(0,0,Max(width shr mipLevel,1)-1,Max(height shr mipLevel,1)-1) // full rect
    else lockRect:=r^;
   if (mode=lmCustomUpdate) and (r<>nil) then
    raise EWarning.Create('GLTex: for custom update must lock full surface');

   if (r<>nil) and (pixelFormat in compressedFormats) then
    raise EWarning.Create('Partial lock is not supported for a compressed texture: '+name);
   mipmaps:=Max(mipmaps,mipLevel);
   GetLevelSize(pixelFormat,Max(width shr mipLevel,1),Max(height shr mipLevel,1),levelPitch,size);
   if length(realdata[mipLevel])=0 then begin // alloc internal storage
    SetLength(realdata[mipLevel],size);
    if realDataObsolete[mipLevel] and (mode<>lmWriteOnly) then begin
     ASSERT(InMainThread,'Trying to read modified texture data outside the main thread');
     DownloadLevel(mipLevel);
    end;
   end;
   pitch:=levelPitch;
   if r=nil then data:=@realData[mipLevel,0]
    else data:=@realData[mipLevel,lockRect.left*PixelSize[pixelFormat] shr 3+lockRect.Top*pitch];
   inc(locked);
   if mode=lmReadWrite then begin
    online:=false;
    Bits.SetFlag(caps,tfDirty);
    AddDirtyRect(lockRect,mipLevel);
   end;
  except
   cs.Leave;
   if locked=0 then EndWrite;
   raise;
  end;
end;

procedure TGLTexture.Unlock;
begin
 ASSERT(locked>0,'Texture not locked: '+name);
 dec(locked);
 cs.Leave;
 if locked=0 then EndWrite; // outer unlock: release exclusive sync
end;

procedure TGLTexture.LockLayer(index:integer;miplevel:byte;mode:TLockMode;r:PRect);
begin
 Lock(mipLevel,mode,r);
end;

procedure TGLTexture.ProcessUploadRequest;
begin
 cs.Enter;
 try
  if uploadrequest.data=nil then exit;
  Upload(uploadRequest.mipLevel,uploadRequest.data,uploadrequest.pitch,uploadRequest.pf);
  Mem.Clear(uploadRequest,sizeof(uploadRequest));
 finally
  cs.Leave;
 end;
end;

procedure TGLTexture.AddDirtyRect(rect:TRect;level:integer);
var
 n:integer;
begin
 if HasFlag(tfImmutable) then
  raise EWarning.Create('AddDirtyRect not allowed for immutable texture: '+name);
 online:=false; Bits.SetFlag(caps,tfDirty);
 n:=dCount[level];
 if n<0 then exit;
 if n<high(dirty[level]) then begin
  dirty[level,n]:=rect;
  inc(dCount[level]);
 end else begin
  // Too many rects - invalidate all
  dCount[level]:=-1; // forbid any more rects
  dirty[level,0]:=Types.Rect(0,0,width-1,height-1);
 end;
end;


procedure TGLTexture.GenerateMipMaps(count:byte);
begin
 NotSupported('Manual mip-map generation: allocate with aiAutoMipMap instead');
end;

procedure TGLTexture.SetAsRenderTarget;
begin
 Assert(HasFlag(tfRenderTarget));
 {$IFDEF GLES}
 glBindFramebuffer(GL_FRAMEBUFFER,fbo); // core in ES 3.0
 {$ELSE}
 if GL_VERSION_3_0 or GL_ARB_framebuffer_object then
  glBindFramebuffer(GL_FRAMEBUFFER,fbo)
 else if GL_EXT_framebuffer_object then
  glBindFramebufferEXT(GL_FRAMEBUFFER,fbo)
 else
  raise EError.Create('SART: Render target not supported');
 {$ENDIF}
 CheckForGLError('SART:'+Describe);
end;

procedure TGLTexture.SetFilter(filter:TTexFilter);
 begin
  self.filter:=filter;
  if texname<>0 then UpdateFilter;
 end;

procedure TGLTexture.SetLabel;
begin
 if name<>'' then begin
  SetGLObjectLabel(GL_TEXTURE,texname,name);
  CheckForGLError('L01');
 end;
end;

// Max anisotropy supported by the GPU, 0 if anisotropic filtering is not available
function GetMaxAnisotropy:single;
begin
 if maxAnisotropy<0 then begin
  maxAnisotropy:=0;
  {$IFDEF GLDESKTOP}
  if GL_VERSION_4_6 or GL_ARB_texture_filter_anisotropic or GL_EXT_texture_filter_anisotropic then
  {$ELSE}
  if GL_EXT_texture_filter_anisotropic then
  {$ENDIF}
   glGetFloatv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT,@maxAnisotropy);
  CheckForGLError('AN1');
  Log.Msg('Max texture anisotropy: %.1f',[maxAnisotropy]);
 end;
 result:=maxAnisotropy;
end;

procedure TGLTexture.UpdateFilter;
var
 fMin,fMax:integer;
 target,aTex:GLInt;
 aniso,maxAniso:single;
begin
 if texname=0 then exit;
 case filter of
  fltUndefined:exit;
  fltNearest:begin
   fMin:=GL_NEAREST;
   fMax:=GL_NEAREST;
  end;
  fltBilinear:begin
   if mipmaps>0 then begin
    fMin:=GL_LINEAR_MIPMAP_NEAREST;
    //fMin:=GL_LINEAR;
    fMax:=GL_LINEAR;
   end else begin
    fMin:=GL_LINEAR;
    fMax:=GL_LINEAR;
   end;
  end;
  fltTrilinear,fltAnisotropic:begin
   if mipmaps>0 then begin
    fMin:=GL_LINEAR_MIPMAP_LINEAR;
    fMax:=GL_LINEAR;
   end else begin
    fMin:=GL_LINEAR;
    fMax:=GL_LINEAR;
   end;
  end;
 end;
 // anisotropy is a texture parameter too: reset it to 1 for other filters
 maxAniso:=GetMaxAnisotropy;
 aniso:=1;
 if (filter=fltAnisotropic) and (mipmaps>0) and (maxAniso>1) then
  aniso:=Clamp(anisotropyLevel,1,maxAniso);
 {$IFNDEF GLES}
 if glFeatures.dsa then begin
  glTextureParameteri(texname,GL_TEXTURE_MIN_FILTER,fMin);
  glTextureParameteri(texname,GL_TEXTURE_MAG_FILTER,fMax);
  if maxAniso>0 then
   glTextureParameterf(texname,GL_TEXTURE_MAX_ANISOTROPY_EXT,aniso);
 end else
 {$ENDIF}
 begin
  target:=GetTextureTarget;
  BindScratch;
  glTexParameteri(target,GL_TEXTURE_MIN_FILTER,fMin);
  glTexParameteri(target,GL_TEXTURE_MAG_FILTER,fMax);
  if maxAniso>0 then
   glTexParameterf(target,GL_TEXTURE_MAX_ANISOTROPY_EXT,aniso);
 end;
 CheckForGLError('16');
end;

procedure TGLTexture.Upload(pixelData:pointer;pitch:integer;pixelFormat:TImagePixelFormat);
 begin
  Upload(0,pixelData,pitch,pixelFormat);
 end;

procedure TGLTexture.Upload(mipLevel:byte;pixelData:pointer;pitch:integer;pixelFormat:TImagePixelFormat);
 var
  format,subformat,internalFormat,error:cardinal;
  bpp,y,lineSize:integer;
  sp,dp:PByte;
  {$IFDEF GLES}
  uploadBuf:pointer;
  {$ENDIF}
 begin
  EnsureWritable('Upload');
  EnsureNotCompressed('Upload');
  if not InMainThread then begin // upload request from non-main thread: sync
   ASSERT(self.pixelFormat=pixelFormat);
   repeat
    cs.Enter;
    if uploadRequest.data=nil then break;
    cs.Leave;
    CoreTime.Sleep(0);
   until false;
   uploadRequest.pitch:=pitch;
   uploadRequest.mipLevel:=mipLevel;
   uploadRequest.pf:=pixelFormat;
   uploadRequest.x:=0;
   uploadRequest.y:=0;
   uploadRequest.width:=0;
   uploadRequest.height:=0;
   uploadRequest.data:=pixelData;
   cs.Leave;
   Signal('GLImages\Upload',TTag(self));
   // wait until request is complete
   while uploadRequest.data<>nil do CoreTime.Sleep(0);
   exit;
  end;
  // Direct upload
  ASSERT(mipLevel<=MAX_LEVEL);
  cs.Enter;
  try
   if mipLevel>mipmaps then mipMaps:=mipLevel;
   if texName=0 then InitStorage;
   BindScratch; // the level is (re)allocated: no DSA call for that
   GetGLFormat(PixelFormat,format,subFormat,internalFormat);
   bpp:=pixelSize[pixelFormat] div 8;
   glPixelStorei(GL_UNPACK_ROW_LENGTH,pitch div bpp);
   {$IFDEF GLES}
   if pixelFormat in [ipfARGB,ipfXRGB] then begin
    uploadBuf:=BGRAToRGBACopy(pixelData,(pitch div bpp)*Max(realheight shr mipLevel,1));
    glTexImage2D(GL_TEXTURE_2D,mipLevel,internalFormat,
      Max(realwidth shr mipLevel,1),Max(realheight shr mipLevel,1),0,format,subFormat,uploadBuf);
    FreeMem(uploadBuf);
   end else
   {$ENDIF}
   glTexImage2D(GL_TEXTURE_2D,mipLevel,internalFormat,
     Max(realwidth shr mipLevel,1),Max(realheight shr mipLevel,1),0,format,subFormat,pixelData);
   CheckForGLError('231');
   online:=true; Bits.Clear(caps,tfDirty);
   InvalidateInternalLevel(mipLevel);
  finally
   cs.Leave;
  end;
 end;

procedure TGLTexture.UploadPart(mipLevel:byte;x,y,width,height:integer;pixelData:pointer;pitch:integer;pixelFormat:TImagePixelFormat);
 var
  format,subformat,internalFormat,error:cardinal;
  bpp:integer;
  {$IFDEF GLES}
  uploadBuf:pointer;
  {$ENDIF}
 begin
  EnsureWritable('UploadPart');
  EnsureNotCompressed('UploadPart');
  ASSERT(InMainThread,'Direct upload is available in the main thread only');
  cs.Enter;
  try
   ASSERT(texName<>0,'Texture '+name+' must be initialized before partial update');
   GetGLFormat(PixelFormat,format,subFormat,internalFormat);
   bpp:=pixelSize[pixelFormat] div 8;
   glPixelStorei(GL_UNPACK_ROW_LENGTH,pitch div bpp);
   {$IFDEF GLES}
   BindScratch;
   if pixelFormat in [ipfARGB,ipfXRGB] then begin
    uploadBuf:=BGRAToRGBACopy(pixelData,(pitch div bpp)*height);
    glTexSubImage2D(GL_TEXTURE_2D,mipLevel,x,y,width,height,format,subFormat,uploadBuf);
    FreeMem(uploadBuf);
   end else
    glTexSubImage2D(GL_TEXTURE_2D,mipLevel,x,y,width,height,format,subFormat,pixelData);
   {$ELSE}
   if glFeatures.dsa then
    glTextureSubImage2D(texname,mipLevel,x,y,width,height,format,subFormat,pixelData)
   else begin
    BindScratch;
    glTexSubImage2D(GL_TEXTURE_2D,mipLevel,x,y,width,height,format,subFormat,pixelData);
   end;
   {$ENDIF}
   CheckForGLError('241');
   InvalidateInternalLevel(mipLevel);
  finally
   cs.Leave;
  end;
 end;

procedure TGLTexture.InitStorage;
 var
  format,subformat,internalFormat,error:cardinal;
  mipLevel:integer;
 begin
  if texName<>0 then exit;
  glGenTextures(1,@texname);
  CheckForGLError('S11');
  BindScratch; // storage is allocated through the binding in any mode
  if HasFlag(tfClamped) then begin
    glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_S,GL_CLAMP_TO_EDGE);
    glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_T,GL_CLAMP_TO_EDGE);
  end else begin
    glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_S,GL_REPEAT);
    glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_T,GL_REPEAT);
  end;
  CheckForGLError('S13');
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAX_LEVEL,mipmaps);
  CheckForGLError('S14');
  // Allocate texture storage
  GetGLFormat(PixelFormat,format,subFormat,internalFormat);
  CheckForGLError('S15');
  // Compressed levels can't be preallocated this way: their storage is created by
  // glCompressedTexImage2D at upload time (see UploadInternalData)
  if not (pixelFormat in compressedFormats) then
   for mipLevel:=0 to mipMaps do begin
    glTexImage2D(GetTextureTarget,mipLevel,internalFormat,
      Max(realwidth shr mipLevel,1),Max(realheight shr mipLevel,1),0,format,subFormat,nil);
    CheckForGLError('S17');
   end;
  SetLabel;
  UpdateFilter;
 end;

procedure TGLTexture.InvalidateInternalLevel(mipLevel: integer);
 begin
  SetLength(realData[0],0); // destroy internal storage
  realDataObsolete[0]:=true;
 end;

function TGLTexture.IsBound(stage:integer):boolean;
 var
  target:integer;
 begin
  target:=GetTextureTarget;
  result:=false;
  case target of
   GL_TEXTURE_2D:result:=boundTex2D[stage]=self;
   GL_TEXTURE_3D:result:=boundTex3D[stage]=self;
   GL_TEXTURE_2D_ARRAY:result:=boundTex2D_Arr[stage]=self;
  end;
 end;

procedure TGLTexture.UploadInternalData;
 var
  needInit,dsa:boolean;
  format,subformat,internalFormat,error:cardinal;
  i,bpp,level,stride:integer;
 begin
  needInit:=false;
  cs.Enter;
  try
  InitStorage;
  // compressed levels are (re)allocated by glCompressedTexImage2D: no DSA call for that
  {$IFDEF GLES}
  dsa:=false;
  {$ELSE}
  dsa:=glFeatures.dsa and not (pixelFormat in compressedFormats);
  {$ENDIF}
  if not dsa then BindScratch;
  GetGLFormat(PixelFormat,format,subFormat,internalFormat);
  // ES 3.0 supports GL_UNPACK_ROW_LENGTH same as desktop GL, so the dirty-rect
  // upload path is shared; only the BGRA->RGBA byte swap below is GLES-specific.
  {$IFDEF GLES}
  if pixelFormat in [ipfARGB,ipfXRGB] then
   for level:=0 to mipmaps do
    if length(realData[level])>0 then
     SwapRedBlue8888(@realData[level,0],length(realData[level]) div 4); // buffer size, not shr dims: `w shr level` hits 0 on tail mips
  {$ENDIF}
  if pixelFormat in compressedFormats then begin
   // Compressed data can only be uploaded a whole level at a time, so dirty rects are ignored
   for level:=0 to mipmaps do
    if (dCount[level]<>0) and (length(realData[level])>0) then begin
     glCompressedTexImage2D(GetTextureTarget,level,internalFormat,
       Max(realWidth shr level,1),Max(realHeight shr level,1),0,
       length(realData[level]),@realData[level,0]);
     CheckForGLError('16');
     dCount[level]:=0;
    end;
  end else
  for level:=0 to mipmaps do
    if dCount[level]<>0 then begin
     // Upload texture data. The CPU copy of a level is packed by the image size (see Lock),
     // not by the storage size: a POT-padded storage is wider
     stride:=Max(width shr level,1);
     glPixelStorei(GL_UNPACK_ROW_LENGTH,stride);
     CheckForGLError('14');
     bpp:=pixelSize[pixelFormat] div 8;
     if dCount[level]<0 then dCount[level]:=1;
     for i:=0 to dCount[level]-1 do
      with dirty[level,i] do
       {$IFNDEF GLES}
       if dsa then
        glTextureSubImage2D(texname,level,Left,Top,right-left+1,bottom-top+1,
           format,subFormat,@realData[level,(left+top*stride)*bpp])
       else
       {$ENDIF}
        glTexSubImage2D(GL_TEXTURE_2D,level,Left,Top,right-left+1,bottom-top+1,
           format,subFormat,@realData[level,(left+top*stride)*bpp]);
     CheckForGLError('15');
     dCount[level]:=0;
    end;
  {$IFDEF GLES}
  // swap back: realData keeps its original BGRA-family in-memory layout for other consumers
  if pixelFormat in [ipfARGB,ipfXRGB] then
   for level:=0 to mipmaps do
    if length(realData[level])>0 then
     SwapRedBlue8888(@realData[level,0],length(realData[level]) div 4); // buffer size, not shr dims: `w shr level` hits 0 on tail mips
  {$ENDIF}
  // Set level limit - otherwise texture sampler will produce black
  {$IFDEF GLES}
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAX_LEVEL,mipmaps);
  if HasFlag(tfAutoMipMap) then // core in ES 3.0
   glGenerateMipmap(GL_TEXTURE_2D);
  {$ELSE}
  if dsa then begin
   glTextureParameteri(texname,GL_TEXTURE_MAX_LEVEL,mipmaps);
   if HasFlag(tfAutoMipMap) then glGenerateTextureMipmap(texname);
  end else begin
   glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAX_LEVEL,mipmaps);
   if HasFlag(tfAutoMipMap) and (GL_VERSION_3_0 or GL_ARB_framebuffer_object) then
    glGenerateMipmap(GL_TEXTURE_2D);
  end;
  {$ENDIF}
  online:=true; Bits.Clear(caps,tfDirty);
  finally
   cs.Leave;
  end;
 end;

{$ENDREGION}

procedure EventHandler(event:TEventStr;tag:TTag);
var
 tex:TTexture;
 tg:TGlTexture;
begin
 if SameText(event,'GLImages\DeleteTexture') then begin
  tex:=TTexture(UIntPtr(tag));
  resourceManagerGL.FreeImage(tex);
 end else
 if SameText(event,'GLImages\Upload') then begin
  tg:=TGLTexture(UIntPtr(tag));
  tg.ProcessUploadRequest;
 end;
end;

{ TGLResourceManager }
{$REGION ResourceManager}
procedure TGLResourceManager.AllocRenderTarget(tex:TGLTexture;flags:cardinal);
var
 format,SubFormat,internalFormat:cardinal;
 status:cardinal;
 prevFramebuffer:GLint;
 renderBuffer:GLUint;
 lab:String8;
begin
 begin
   if tex.name='UI_HintImage' then
    Log.Debug(sysUtils.Format('AllocImage RT %dx%d %d (%s)',[tex.width,tex.height,flags,tex.name]))
   else
    Log.Msg(sysUtils.Format('AllocImage RT %dx%d %d (%s)',[tex.width,tex.height,flags,tex.name]));
  if Max(tex.width,tex.height)>maxRTsize then raise EWarning.Create('AI: RT texture too large');
  {$IFDEF GLES}
  // Rewritten from scratch during the ES 3.0 cleanup (2026-07-03): the previous GLES11
  // branch here referenced an undeclared `zTex` and bare `width`/`height` locals that
  // don't exist in this signature - it never actually compiled for any real target.
  // This path mirrors the desktop branch below but is UNTESTED on real GLES hardware/ANGLE
  // (only compile-checked, per the GLES cleanup task's code-only scope). Needs runtime
  // sign-off once R-24/R-30 bring up an actual mobile/ANGLE target.
  glGenFramebuffers(1,@tex.fbo);
  glBindFramebuffer(GL_FRAMEBUFFER,tex.fbo);
  lab:='FBO:'+tex.name;
  if lab='FBO:' then lab:='FBO#'+IntToStr(tex.fbo);
  SetGLObjectLabel(GL_FRAMEBUFFER,tex.fbo,lab);
  glGenTextures(1,@tex.texname);
  tex.BindScratch;
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR);
  tex.filter:=fltBilinear;
  if Bits.HasAll(flags,aiClampUV) then begin
   glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_S,GL_CLAMP_TO_EDGE);
   glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_T,GL_CLAMP_TO_EDGE);
   Bits.SetFlag(tex.caps,tfClamped);
  end;
  GetGLFormat(tex.pixelFormat,format,subFormat,internalFormat);
  glTexImage2D(GL_TEXTURE_2D,0,internalFormat,tex.width,tex.height,0,format,subFormat,nil);
  glFramebufferTexture2D(GL_FRAMEBUFFER,GL_COLOR_ATTACHMENT0,GL_TEXTURE_2D,tex.texname,0);
  if Bits.HasAll(flags,aiDepthBuffer) then begin
   glGenRenderbuffers(1,@renderBuffer);
   glBindRenderbuffer(GL_RENDERBUFFER,renderBuffer);
   glRenderbufferStorage(GL_RENDERBUFFER,DEPTH_RB_FORMAT,tex.width,tex.height);
   glFramebufferRenderbuffer(GL_FRAMEBUFFER,GL_DEPTH_ATTACHMENT,GL_RENDERBUFFER,renderBuffer);
   tex.rbo:=renderBuffer;
  end;
  status:=glCheckFramebufferStatus(GL_FRAMEBUFFER);
  if status<>GL_FRAMEBUFFER_COMPLETE then
   raise EError.Create('FBO status: '+inttostr(status));
  {$ENDIF GLES}

  {$IFNDEF GLES}
  // Standard way: use FBO
  glGenFramebuffers(1,@tex.fbo);
  CheckForGLError('1'); // validate FBO creation itself
  // Save current framebuffer
  glGetIntegerv(GL_DRAW_FRAMEBUFFER_BINDING,@prevFramebuffer);
  glBindFramebuffer(GL_FRAMEBUFFER,tex.fbo);
  lab:='FBO:'+tex.name;
  // Keep useful label even for unnamed temporary render targets.
  if lab='FBO:' then lab:='FBO#'+IntToStr(tex.fbo);
  SetGLObjectLabel(GL_FRAMEBUFFER,tex.fbo,lab);
  CheckForGLError('2');
  glGenTextures(1,@tex.texname);
  tex.BindScratch;
  CheckForGLError('3');
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR);
  tex.filter:=fltBilinear;
  if Bits.HasAll(flags,aiClampUV) then begin
   glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_S,GL_CLAMP_TO_EDGE);
   glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_T,GL_CLAMP_TO_EDGE);
   Bits.SetFlag(tex.caps,tfClamped);
  end;
  if (tex.pixelFormat in [ipfNone,ipfDepth32f]) and Bits.HasAll(flags,aiDepthBuffer) then begin
   // No pixel format, but need depth buffer: allocate depth buffer only
   if tex.pixelFormat=ipfNone then begin
    // No need to access depth values - allocate renderbuffer storage
    glGenRenderbuffers(1,@renderBuffer);
    glBindRenderbuffer(GL_RENDERBUFFER, renderBuffer);
    glRenderbufferStorage(GL_RENDERBUFFER, DEPTH_RB_FORMAT, tex.width, tex.height);
    glFramebufferRenderBuffer(GL_FRAMEBUFFER,GL_DEPTH_ATTACHMENT, GL_RENDERBUFFER, renderBuffer);
    tex.rbo:=renderBuffer;
   end else begin
    // Allocate texture storage
    glTexImage2D(GL_TEXTURE_2D,0,GL_DEPTH_COMPONENT,tex.width,tex.height,0,GL_DEPTH_COMPONENT,GL_FLOAT,nil);
    glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR);
    glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR);
    glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_COMPARE_MODE,GL_COMPARE_REF_TO_TEXTURE); // enable comparison mode
    glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_COMPARE_FUNC,GL_LESS); // enable comparison mode

    glFramebufferTexture(GL_FRAMEBUFFER,GL_DEPTH_ATTACHMENT,tex.texname,0);
    glDrawBuffer(GL_NONE);
    glReadBuffer(GL_NONE);
   end;
  end else begin
   GetGLFormat(tex.pixelFormat,format,subFormat,internalFormat);
   glTexImage2D(GL_TEXTURE_2D,0,internalFormat,tex.width,tex.height,0,format,subFormat,nil);
   CheckForGLError('4');
   glFramebufferTexture(GL_FRAMEBUFFER,GL_COLOR_ATTACHMENT0,tex.texname,0);

   if Bits.HasAll(flags,aiDepthBuffer) then begin
    glGenRenderbuffers(1,@renderBuffer);
    glBindRenderbuffer(GL_RENDERBUFFER, renderBuffer);
    glRenderbufferStorage(GL_RENDERBUFFER, DEPTH_RB_FORMAT, tex.width, tex.height);
    glFramebufferRenderBuffer(GL_FRAMEBUFFER,GL_DEPTH_ATTACHMENT, GL_RENDERBUFFER, renderBuffer);
    tex.rbo:=renderBuffer;
   end;
   glDrawBuffer(GL_COLOR_ATTACHMENT0);
  end;

  status:=glCheckFramebufferStatus(GL_FRAMEBUFFER);
  // Restore previous framebuffer binding
  glBindFramebuffer(GL_FRAMEBUFFER,prevFramebuffer);

  if status<>GL_FRAMEBUFFER_COMPLETE then
   raise EError.Create('FBO status: '+inttostr(status));

  {$ENDIF}
  Bits.SetFlag(tex.caps,tfRenderTarget+tfNoRead+tfNoWrite);
  tex.online:=true; Bits.Clear(tex.caps,tfDirty);
 end;
end;

function TGLResourceManager.AllocImage(width,height:integer; PixFmt:TImagePixelFormat; flags:cardinal;
  name:String8):TTexture;
begin
 result:=AllocImage(width,height,0,pixFmt,flags,name);
end;

function TGLResourceManager.AllocImage(width,height,mipLevels:integer; PixFmt:TImagePixelFormat; flags:cardinal;
  name:String8):TTexture;
var
 tex:TGlTexture;
 dataSize:integer;
begin
 ASSERT((width>0) AND (height>0),'Zero width or height: '+name);
 ASSERT((pixFmt<>ipfNone) or Bits.HasAll(flags,aiDepthBuffer),'Invalid pixel format for '+name);
 if not Bits.HasAll(flags,aiSysMem) and ((width>maxTextureSize) or (height>maxTextureSize)) then
  raise EWarning.Create('AI: Texture too large');
 if (pixFmt in compressedFormats) and not CompressedFormatSupported(pixFmt) then
  raise EWarning.Create('Compressed texture format is not supported by the GPU: '+PixFmt2Str(pixFmt));
 tex:=nil;
 try
 cSect.Enter;
 try
 tex:=TGLTexture.Create;
 result:=tex;
 tex.width:=width;
 tex.height:=height;
 // NPOT textures (incl. render targets) are a hard requirement of the engine
 // baseline (GL 3.3 core / GLES 3.0), so dimensions are never rounded up
 // automatically — only when aiPow2 is explicitly requested (mip-mapped or tiled
 // textures). The old auto-fallback keyed off GL_ARB_texture_non_power_of_two,
 // which core profiles don't advertise (macOS = GL 4.1 core via Metal), so it
 // silently pow2-rounded every RT and corrupted its UVs.
 if Bits.HasAll(flags,aiPow2) then begin
  width:=NextPow2(width);
  height:=NextPow2(height);
 end;
 tex.realwidth:=width;
 tex.realHeight:=height;
 // Compressed data is uploaded as whole levels, so the internal storage must match
 // the texture exactly - there is no room for POT padding
 if (pixFmt in compressedFormats) and ((width<>tex.width) or (height<>tex.height)) then
  raise EWarning.Create('Compressed texture can''t be padded to POT: '+name);
 if Bits.HasAll(flags,aiThreadLocal) then begin
  Bits.SetFlag(tex.caps,tfThreadLocal);
  tex.ownerThread:=GetCurrentThreadID; // caller's thread owns this texture
  if (name<>'') and (name[1]<>'_') then
   tex.name:='_'+name // non-unique prefix: skips global name registry
  else
   tex.name:=name;
 end else
  tex.name:=name;
 tex.PixelFormat:=PixFmt;
 tex.online:=false;
 Bits.SetFlag(tex.caps,tfDirty);
 if Bits.HasAll(flags,aiPixelated) then
  tex.filter:=fltNearest
 else
  tex.filter:=fltTrilinear;

 if flags and aiRenderTarget>0 then begin
  AllocRenderTarget(tex,flags);
 end else begin
  {// Not render target -> NO ANY GL* CALLS TO ALLOW MULTITHREADED ALLOCATION
  tex.pitch:=width*pixelSize[pixFmt] div 8;
  datasize:=tex.pitch*height;
  if pixFMT in [ipfDXT1,ipfDXT3,ipfDXT5] then begin
   tex.pitch:=tex.pitch div 4;
   datasize:=datasize div 16;
  end;
  SetLength(tex.realData[0],datasize);}

  Bits.SetFlag(tex.caps,tfDirectAccess); // Can be locked
  if Bits.HasAll(flags,aiClampUV) then
   Bits.SetFlag(tex.caps,tfClamped);
  // Mip-maps -> enable automatic generation.
  // Compressed textures are excluded: glGenerateMipmap is invalid for them, and the
  // loaders provide level 0 only (a DDS mip chain would have to be uploaded level by level)
  if Bits.HasAll(flags,aiAutoMipmap) and not (pixFmt in compressedFormats) then begin
   Bits.SetFlag(tex.caps,tfAutoMipMap);
   tex.mipmaps:=Clamp(Log2i(Max(width,height)+1)-1,0,tex.MAX_LEVEL); // floor(log2): an NPOT chain ends at 1 pixel
  end else
  if pixFmt in compressedFormats then
   tex.mipmaps:=0
  else
   tex.mipmaps:=mipLevels;
 end;

 // Image can use the texture partialy
 tex.u1:=0; tex.u2:=tex.width/width;
 tex.v1:=0; tex.v2:=tex.height/height;
 tex.stepU:=0.5*(tex.u2-tex.u1)/tex.width;
 tex.stepV:=0.5*(tex.v2-tex.v1)/tex.height;
 finally cSect.Leave;
 end;
 except
  on e:Exception do begin
   if tex<>nil then tex.Free;
   result:=nil;
   Log.Msg('AllocImage error: '+ExceptionMsg(e));
   raise;
  end;
 end;
end;

function TGLResourceManager.AllocArray(width,height:integer;PixFmt:TImagePixelFormat;
                arraySize:integer;flags:cardinal;name:String8):TGLTextureArray;
var
 tex:TGlTextureArray;
 dataSize,z:integer;
begin
 ASSERT((width>0) AND (height>0),'Zero width or height: '+name);
 ASSERT((pixFmt<>ipfNone) or Bits.HasAll(flags,aiDepthBuffer),'Invalid pixel format for '+name);
 if (flags and aiSysMem=0) and ((width>maxTextureSize) or (height>maxTextureSize)) then
  raise EWarning.Create('AI: Texture too large');
 tex:=nil;
 try
 cSect.Enter;
 try
 tex:=TGLTextureArray.Create(arraySize);
 result:=tex;
 tex.width:=width;
 tex.height:=height;
 if (flags and aiPow2>0) then begin // explicit opt-in only; NPOT is baseline (see AllocImage above)
  width:=NextPow2(width);
  height:=NextPow2(height);
 end;
 tex.realwidth:=width;
 tex.realHeight:=height;
 tex.name:=name;
 tex.pixelFormat:=pixFmt;
 tex.online:=false;
 Bits.SetFlag(tex.caps,tfDirty);
 if Bits.HasAll(flags,aiPixelated) then
  tex.filter:=fltNearest
 else
  tex.filter:=fltTrilinear;

 if Bits.HasAll(flags,aiTexture3D) then Bits.SetFlag(tex.caps,tfTexture);

 tex.pitch:=width*pixelSize[pixFmt] div 8;
 datasize:=tex.pitch*height;
 if pixFMT in [ipfDXT1,ipfDXT3,ipfDXT5] then begin
  tex.pitch:=tex.pitch div 4;
  datasize:=datasize div 16;
 end;
 for z:=0 to high(tex.layers) do begin
  tex.layers[z]:=AllocImage(width,height,pixFmt,0,name+'_lay'+inttostr(z)) as TGLTexture;
{  tex.layers[z].width:=width;
  tex.layers[z].height:=height;
  tex.layers[z].pixelFormat:=tex.pixelFormat;
  tex.layers[z].realwidth:=width;
  tex.layers[z].realheight:=height;
  SetLength(tex.layers[z].realData[0],datasize);}
 end;

 Bits.SetFlag(tex.caps,tfDirectAccess); // Can be locked
 if Bits.HasAll(flags,aiClampUV) then
  Bits.SetFlag(tex.caps,tfClamped);
  // Mip-maps
 if Bits.HasAll(flags,aiAutoMipmap) then begin
  Bits.SetFlag(tex.caps,tfAutoMipMap);
  tex.mipmaps:=Log2i(Max(width,height)+1)-1; // floor(log2): an NPOT chain ends at 1 pixel
 end;

 tex.u1:=0; tex.u2:=tex.width/width;
 tex.v1:=0; tex.v2:=tex.height/height;
 tex.stepU:=0.5*(tex.u2-tex.u1)/tex.width;
 tex.stepV:=0.5*(tex.v2-tex.v1)/tex.height;
 finally cSect.Leave;
 end;
 except
  on e:Exception do begin
   if tex<>nil then tex.Free;
   result:=nil;
   Log.Msg('AllocImage error: '+ExceptionMsg(e));
   raise;
  end;
 end;
end;

constructor TGLResourceManager.Create;
var
 texUnits:GLint;
begin
 try
  resourceManagerGL:=self;

  glPixelStorei(GL_UNPACK_ALIGNMENT,1);
  mainThreadID:=GetCurrentThreadId;
  resourceManagerGL:=self;
  SetEventHandler('GLImages',EventHandler,emMixed);
  {$IFDEF GLES}
  glGetIntegerv(GL_MAX_TEXTURE_SIZE, @maxTextureSize);
  maxRBsize:=maxTextureSize;
  {$ELSE}
  glGetIntegerv(GL_MAX_TEXTURE_SIZE, @maxTextureSize);
  glGetIntegerv(GL_MAX_RENDERBUFFER_SIZE, @maxRBsize);
  {$ENDIF}
  maxRTsize:=Min(maxTextureSize,maxRBsize);
  Log.Msg(Format('Maximal sizes: TEX: %d / RT: %d / RB: %d',[maxTextureSize,maxRTsize,maxRBsize]));
  glGetIntegerv(GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS,@texUnits);
  if texUnits<=TEX_UNIT_SCRATCH then // below the minimum of GL 3.3 and ES 3.0
   raise EError.Create(Format('%d texture units, %d required',[texUnits,TEX_UNIT_SCRATCH+1]));
 except
  on e:Exception do begin
   Log.Force('Error in GLTexMan constructor: '+ExceptionMsg(e));
   raise EFatalError.Create('GLTextMan: '+ExceptionMsg(e));
  end;
 end;
 CheckForGLError('ResMan.Create');
end;

destructor TGLResourceManager.Destroy;
var
 hash:PObjectHash;
 list:TNamedObjects;
 i,leftoverCnt:integer;
begin
 // Requires a valid GL context because FreeImage deletes GL objects.
 // If some textures are still alive here, we log and force cleanup.
 DebugMsg('[LIFECYCLE] Destroy %s',[ClassName]);
 Log.Msg('[LIFECYCLE] Destroy '+ClassName);
 // Free all remaining textures
 hash:=TGLTexture.ClassHash;
 if hash<>nil then begin
  list:=hash.ListObjects;
  leftoverCnt:=length(list);
  if leftoverCnt>0 then begin
   Log.Warn('GLResourceManager.Destroy: %d textures are still alive, forcing cleanup',[leftoverCnt]);
  end;
  for i:=0 to high(list) do
   FreeImage(TTexture(list[i]));
 end;
 resourceManagerGL:=nil;
 inherited;
end;

procedure TGLResourceManager.Dump(st:string);
begin

end;

procedure TGLResourceManager.FreeImage(var image:TTexture);
var
 tex:TGLTexture;
 level:integer;
begin
 // Must run on render thread with active GL context for actual GPU deletion.
 // Non-main thread requests are marshalled via GLImages\DeleteTexture signal.
 if image=nil then exit;
 // Wrong thread?
 if not InMainThread then begin
  if not (image is TGLTexture) then raise EError.Create('Not a GLTexture! '+IntToHEx(cardinal(image),8));
  Signal('GLIMAGES\DeleteTexture',TTag(image));
  image:=nil;
  exit;
 end;
 cSect.Enter;
 try
 dec(image.refCounter);
 if image.refCounter>=0 then begin
  image:=nil;
  exit; // prevent object deletion
 end;

 if image.parent<>nil then begin
  TGLTexture(image).DetachView; // while the parent is still known (and alive)
  FreeImage(image.parent);
 end;

 if image is TGLTexture then begin
  tex:=image as TGLTexture;
  if tex.fbo<>0 then begin // free framebuffer
   {$IFDEF GLES}
   glDeleteFramebuffers(1,@tex.fbo); // core in ES 3.0
   {$ELSE}
   if GL_VERSION_3_0 or GL_ARB_framebuffer_object then
    glDeleteFramebuffers(1,@tex.fbo)
   else
   if GL_EXT_framebuffer_object then
    glDeleteFramebuffersExt(1,@tex.fbo)
   else
    raise EError.Create('TexMan FI: framebuffers not supported!');
   {$ENDIF}
  end;
  if tex.rbo<>0 then glDeleteRenderbuffers(1,@tex.rbo);
  tex.rbo:=0;
  if tex.texname<>0 then glDeleteTextures(1,@tex.texname);
  tex.texname:=0;
  UnbindTex(tex);
  if shadersAPI<>nil then shadersAPI.ForgetTexture(tex); // a later shader switch rebinds the current textures
  tex.Free;
  image:=nil;
 end else
  raise EWarning.Create('FI: not a GL texture');
 finally
  cSect.Leave;
 end;
end;

procedure TGLResourceManager.FreeMetaTexSpace(n: integer);
begin

end;

procedure TGLResourceManager.FreeVidMem;
begin

end;

function TGLResourceManager.GetStatus(line:byte):string;
begin
 result:='';
 raise EError.Create('TGLResourceManager.GetStatus is not implemented');
end;

procedure TGLResourceManager.SetTexFilter(img:TTexture;filter:TTexFilter);
begin
 TGLTexture(img).filter:=filter;
 TGLTexture(img).UpdateFilter;
end;

procedure TGLResourceManager.MakeOnline(img:TTexture);
var
 tex:TGLTexture;
begin
 if img=nil then begin
  //curTextures[stage]:=nil;
  exit;
 end;
 ASSERT(img is TGLTexture);
 tex:=TGLTexture(img);
 if not tex.online then tex.UploadInternalData;
end;

procedure TGLResourceManager.BindToUnit(img:TTexture;texUnit:integer);
var
 tex:TGLTexture;
begin
 ASSERT((img is TGLTexture) and (texUnit>=0) and (texUnit<TEX_UNIT_SCRATCH));
 tex:=TGLTexture(img);
 if not tex.online then tex.UploadInternalData; // allocates the GL name on the first upload
 if tex.IsBound(texUnit) then exit;
 ActiveTextureUnit(texUnit);
 tex.Bind;
end;

function TGLResourceManager.QueryParams(width, height: integer;
  format: TImagePixelFormat; usage: integer): boolean;
var
 res,maxSize:integer;
 glFormat,subFormat,InternalFormat:cardinal;
begin
 result:=true;
 if not (format in [ipfARGB,ipfRGB,ipf1555,ipf4444,ipf565]) then begin
  result:=false;
  exit;
 end;
 if usage and aiRenderTarget<>0 then maxSize:=maxRTsize
  else maxSize:=maxTextureSize;
 if (width>maxSize) or (height>maxSize) then begin
  result:=false;
  exit;
 end;
 // GL_PROXY_TEXTURE_2D doesn't exist in GLES: the size limit comparison above
 // is the whole check there, no format-capability probe.
 {$IFNDEF GLES}
 GetGLFormat(format,glFormat,subFormat,internalFormat);
 glTexImage2D(GL_PROXY_TEXTURE_2D,0,internalFormat,width,height,0,glFormat,subFormat,nil);
 glGetTexLevelParameteriv(GL_PROXY_TEXTURE_2D,0,GL_TEXTURE_INTERNAL_FORMAT,@res);
 CheckForGLError('18');
 if res=0 then result:=false;
 {$ENDIF}
end;

procedure TGLResourceManager.ResizeImage(var img:TTexture;newWidth,newHeight:integer);
var
 glFormat,subFormat,internalFormat:cardinal;
 old:TTexture;
begin
 // Render target -> resize
 // TODO: consider size quantization (over-allocate storage, render via viewport) to avoid
 // driver-side realloc on every tick of interactive window resize (resize storm)
 if img.HasFlag(tfRenderTarget) then
  with img as TGLTexture do begin
   width:=newWidth;
   height:=newHeight;
   if texName<>0 then begin /// TODO: check carefuly
    BindScratch;
    GetGLFormat(img.PixelFormat,glFormat,subFormat,internalFormat);
    glTexImage2D(GL_TEXTURE_2D,0,internalFormat,width,height,0,glFormat,subFormat,nil);
   end;
   CheckForGLError('19');
   if rbo<>0 then begin
    glBindRenderbuffer(GL_RENDERBUFFER, rbo);
    glRenderbufferStorage(GL_RENDERBUFFER, DEPTH_RB_FORMAT, width, height);
   end;
   exit;
  end;
 // Regular texture -> re-allocate
 old:=img;
 img:=AllocImage(newWidth,newHeight,img.PixelFormat,img.caps,img.name);
 FreeImage(old);
end;

procedure TGLResourceManager.AttachDepthBuffer(tex,dBuf:TTexture);
var
 target,depth:TGLTexture;
 prevFrameBuffer:glint;
begin
 ASSERT(tex.HasFlag(tfRenderTarget));
 ASSERT(dBuf.HasFlag(tfRenderTarget));
 target:=tex as TGLTexture;
 depth:=dBuf as TGLTexture;
 // Save framebuffer binding
 glGetIntegerv(GL_DRAW_FRAMEBUFFER_BINDING,@prevFramebuffer);
 glBindFramebuffer(GL_FRAMEBUFFER,target.fbo);
 if depth.rbo<>0 then
  glFramebufferRenderBuffer(GL_FRAMEBUFFER,GL_DEPTH_ATTACHMENT,GL_RENDERBUFFER,depth.rbo)
 else
  {$IFDEF GLES}
  // glFramebufferTexture (no target dimension) is GL 3.2+/ES 3.2, not core in ES 3.0.
  glFramebufferTexture2D(GL_FRAMEBUFFER,GL_DEPTH_ATTACHMENT,GL_TEXTURE_2D,depth.texname,0);
  {$ELSE}
  glFramebufferTexture(GL_FRAMEBUFFER,GL_DEPTH_ATTACHMENT,depth.texname,0);
  {$ENDIF}

 // Restore framebuffer binding
 glBindFramebuffer(GL_FRAMEBUFFER,prevFrameBuffer);
end;
{$ENDREGION}

// ---- Data buffers ----
{$REGION BUFFERS}
function TGLResourceManager.AllocVertexBuffer(layout:TVertexLayout;numVertices:integer;
  usage:TBufferUsage;flags:cardinal):TVertexBuffer;
var
 vb:TVertexBufferGL;
begin
 vb:=TVertexBufferGL.Create(layout,numVertices,flags);
 vb.publishedSync:=nil;
 glGenBuffers(1,@vb.buffer);
 ASSERT(vb.buffer<>0);
 glBindBuffer(GL_ARRAY_BUFFER,vb.buffer);
 TrackArrayBufferBinding(vb.buffer);
 case usage of
  buStatic:    vb.usage:=GL_STATIC_DRAW;
  buDynamic:   vb.usage:=GL_DYNAMIC_DRAW;
  buTemporary: vb.usage:=GL_STREAM_DRAW;
 end;
 glBufferData(GL_ARRAY_BUFFER,vb.strideBytes*numVertices,nil,vb.usage);
 CheckForGLError('AllocVB'); // validate real allocation call
 // Stage 7: semantic label is taken from vb.debugName when provided by caller.
 SetGLObjectLabel(GL_BUFFER,vb.buffer,BuildVBLabel(vb));
 result:=vb;
end;

// Layout-less vertex buffer with an explicit byte stride (R-19 TGpuMesh path).
// The caller binds attributes via renderDevice.BindMeshLayout(TGpuLayout), so the
// packed TVertexLayout is not involved.
function TGLResourceManager.AllocRawVertexBuffer(strideBytes,numVertices:integer;
  usage:TBufferUsage;flags:cardinal):TVertexBuffer;
var
 vb:TVertexBufferGL;
begin
 vb:=TVertexBufferGL.Create(strideBytes,numVertices,flags);
 vb.publishedSync:=nil;
 glGenBuffers(1,@vb.buffer);
 ASSERT(vb.buffer<>0);
 glBindBuffer(GL_ARRAY_BUFFER,vb.buffer);
 TrackArrayBufferBinding(vb.buffer);
 case usage of
  buStatic:    vb.usage:=GL_STATIC_DRAW;
  buDynamic:   vb.usage:=GL_DYNAMIC_DRAW;
  buTemporary: vb.usage:=GL_STREAM_DRAW;
 end;
 glBufferData(GL_ARRAY_BUFFER,vb.strideBytes*numVertices,nil,vb.usage);
 CheckForGLError('AllocRawVB');
 SetGLObjectLabel(GL_BUFFER,vb.buffer,BuildVBLabel(vb));
 result:=vb;
end;

function TGLResourceManager.AllocIndexBuffer(indCount:integer;elementSize:integer;
  usage:TBufferUsage;flags:cardinal):TIndexBuffer;
var
 ib:TIndexBufferGL;
begin
 ASSERT(elementSize in [2,4]);
 ib:=TIndexBufferGL.Create(indCount,elementSize,flags);
 ib.publishedSync:=nil;
 glGenBuffers(1,@ib.buffer);
 ASSERT(ib.buffer<>0);
 glBindBuffer(GL_ELEMENT_ARRAY_BUFFER,ib.buffer);
 TrackElementBufferBinding(ib.buffer);
 case usage of
  buStatic:    ib.usage:=GL_STATIC_DRAW;
  buDynamic:   ib.usage:=GL_DYNAMIC_DRAW;
  buTemporary: ib.usage:=GL_STREAM_DRAW;
 end;
 glBufferData(GL_ELEMENT_ARRAY_BUFFER,indCount*elementSize,nil,ib.usage);
 CheckForGLError('AllocIB'); // validate real allocation call
 // Stage 7: semantic label is taken from ib.debugName when provided by caller.
 SetGLObjectLabel(GL_BUFFER,ib.buffer,BuildIBLabel(ib));
 result:=ib;
end;

procedure TGLResourceManager.UseVertexBuffer(vb:TVertexBuffer);
begin
 if vb<>nil then vb.BeginRead;
 if vb<>nil then
  glBindBuffer(GL_ARRAY_BUFFER,TVertexBufferGL(vb).buffer)
 else
  glBindBuffer(GL_ARRAY_BUFFER,0);
 if vb<>nil then
  TrackArrayBufferBinding(TVertexBufferGL(vb).buffer)
 else
  TrackArrayBufferBinding(0);
 if vb<>nil then vb.EndRead;
end;

procedure TGLResourceManager.UseIndexBuffer(ib:TIndexBuffer);
begin
 if ib<>nil then ib.BeginRead;
 if ib<>nil then
  glBindBuffer(GL_ELEMENT_ARRAY_BUFFER,TIndexBufferGL(ib).buffer)
 else
  glBindBuffer(GL_ELEMENT_ARRAY_BUFFER,0);
 if ib<>nil then
  TrackElementBufferBinding(TIndexBufferGL(ib).buffer)
 else
  TrackElementBufferBinding(0);
 if ib<>nil then ib.EndRead;
end;

procedure TGLResourceManager.FreeBuffer(buf:TEngineBuffer);
begin
 if buf<>nil then buf.Free;
end;

{ TVertexBufferGL }

destructor TVertexBufferGL.Destroy;
begin
 ResetPublishState;
 if buffer<>0 then glDeleteBuffers(1,@buffer);
 inherited;
end;

destructor TIndexBufferGL.Destroy;
begin
 ResetPublishState;
 if buffer<>0 then glDeleteBuffers(1,@buffer);
 inherited;
end;

procedure TVertexBufferGL.Resize(newCount:integer);
begin
 EnsureWritable('Resize');
 BeginWrite;
 count:=newCount;
 sizeInBytes:=count*strideBytes;
 glBindBuffer(GL_ARRAY_BUFFER,buffer);
 TrackArrayBufferBinding(buffer);
 glBufferData(GL_ARRAY_BUFFER,sizeInBytes,nil,usage);
 glBindBuffer(GL_ARRAY_BUFFER,0);
 TrackArrayBufferBinding(0);
 EndWrite;
end;

procedure TVertexBufferGL.Upload(fromVertex,numVertices:integer;vertexData:pointer);
begin
 EnsureWritable('Upload');
 BeginWrite;
 glBindBuffer(GL_ARRAY_BUFFER,buffer);
 TrackArrayBufferBinding(buffer);
 glBufferSubData(GL_ARRAY_BUFFER,fromVertex*strideBytes,numVertices*strideBytes,vertexData);
 glBindBuffer(GL_ARRAY_BUFFER,0);
 TrackArrayBufferBinding(0);
 EndWrite;
end;

procedure TIndexBufferGL.Resize(newCount:integer);
begin
 EnsureWritable('Resize');
 BeginWrite;
 count:=newCount;
 sizeInBytes:=count*bytesPerIndex;
 glBindBuffer(GL_ELEMENT_ARRAY_BUFFER,buffer);
 TrackElementBufferBinding(buffer);
 glBufferData(GL_ELEMENT_ARRAY_BUFFER,sizeInBytes,nil,usage);
 glBindBuffer(GL_ELEMENT_ARRAY_BUFFER,0);
 TrackElementBufferBinding(0);
 EndWrite;
end;

procedure TIndexBufferGL.Upload(fromIndex,numIndices:integer;indexData:pointer);
begin
 EnsureWritable('Upload');
 BeginWrite;
 glBindBuffer(GL_ELEMENT_ARRAY_BUFFER,buffer);
 TrackElementBufferBinding(buffer);
 glBufferSubData(GL_ELEMENT_ARRAY_BUFFER,fromIndex*bytesPerIndex,numIndices*bytesPerIndex,indexData);
 glBindBuffer(GL_ELEMENT_ARRAY_BUFFER,0);
 TrackElementBufferBinding(0);
 EndWrite;
end;

procedure TVertexBufferGL.PublishUpdate;
begin
 if IsThreadLocal then exit;
 if @glFenceSync=nil then exit;
 ResetPublishState;
 publishedSync:=pointer(glFenceSync(GL_SYNC_GPU_COMMANDS_COMPLETE,0));
 if @glFlush<>nil then glFlush;
end;

procedure TVertexBufferGL.WaitForPublish;
begin
 if publishedSync=nil then exit;
 if @glWaitSync<>nil then
  glWaitSync(GLsync(publishedSync),0,high(uint64))
 else
 if @glClientWaitSync<>nil then
  glClientWaitSync(GLsync(publishedSync),GL_SYNC_FLUSH_COMMANDS_BIT,high(uint64));
 ResetPublishState;
end;

procedure TVertexBufferGL.ResetPublishState;
begin
 if publishedSync=nil then exit;
 if @glDeleteSync<>nil then
  glDeleteSync(GLsync(publishedSync));
 publishedSync:=nil;
end;

procedure TIndexBufferGL.PublishUpdate;
begin
 if IsThreadLocal then exit;
 if @glFenceSync=nil then exit;
 ResetPublishState;
 publishedSync:=pointer(glFenceSync(GL_SYNC_GPU_COMMANDS_COMPLETE,0));
 if @glFlush<>nil then glFlush;
end;

procedure TIndexBufferGL.WaitForPublish;
begin
 if publishedSync=nil then exit;
 if @glWaitSync<>nil then
  glWaitSync(GLsync(publishedSync),0,high(uint64))
 else
 if @glClientWaitSync<>nil then
  glClientWaitSync(GLsync(publishedSync),GL_SYNC_FLUSH_COMMANDS_BIT,high(uint64));
 ResetPublishState;
end;

procedure TIndexBufferGL.ResetPublishState;
begin
 if publishedSync=nil then exit;
 if @glDeleteSync<>nil then
  glDeleteSync(GLsync(publishedSync));
 publishedSync:=nil;
end;
{$ENDREGION}

// --- Robot API command handler ---

type
  TTextureAccess=class(TTexture)
    class function ListAll:TNamedObjects;
  end;

class function TTextureAccess.ListAll:TNamedObjects;
var
  hash:PObjectHash;
begin
  hash:=ClassHash;
  if hash<>nil then result:=hash^.ListObjects
  else SetLength(result,0);
end;

function RobotCmdResources(const req:TRobotRequest; out body:String8):boolean;
var
  objects:TNamedObjects;
  i:integer;
  t:TGLTexture;
begin
  body:='';
  objects:=TTextureAccess.ListAll;
  for i:=0 to high(objects) do begin
    if not (objects[i] is TGLTexture) then continue;
    t:=TGLTexture(objects[i]);
    body:=body+'TEX: '+t.name+LineBreak+
      '  glName: '+Conv.ToStr(integer(t.texname))+LineBreak+
      '  width: '+Conv.ToStr(t.width)+LineBreak+
      '  height: '+Conv.ToStr(t.height)+LineBreak+
      '  realWidth: '+Conv.ToStr(t.realWidth)+LineBreak+
      '  realHeight: '+Conv.ToStr(t.realHeight)+LineBreak+
      '  format: '+GetEnumName(TypeInfo(TImagePixelFormat),ord(t.pixelFormat))+LineBreak+
      '  hasFBO: '+Conv.ToStr(t.fbo<>0)+LineBreak;
  end;
  result:=true;
end;

initialization
  RegisterRobotCommand('resources',@RobotCmdResources);
  cSect.Init('GLTexMan',160);
finalization
  cSect.Cleanup;
end.