Apus.Engine.Resources.pas

// Base resource classes and types - extracted from Engine.API
//
// Copyright (C) 2021 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/)
unit Apus.Engine.Resources;
interface
 uses Apus.Core, Apus.Classes, Apus.Images, Apus.Engine.Types, Apus.Threads;

 const
  // Buffer allocation policy flags
  abThreadLocal    = $0001; // buffer is owned by a single render thread/window
  abImmutable      = $0002; // immutable after initial upload/finalize
  abShared         = $0004; // explicit shared-intent marker (diagnostic/policy hint)

  // Internal buffer capability flags
  bfThreadLocal    = $0001;
  bfImmutable      = $0002;
  bfSharedHint     = $0004;

  // Texture features flags
  tfCanBeLost      = 1;    // Texture data can be lost at any moment
  tfDirectAccess   = 2;    // CPU access allowed, texture can be locked
  tfNoRead         = 4;    // Reading of texture data is not allowed
  tfNoWrite        = 8;    // Writing to texture data is not allowed
  tfRenderTarget   = 16;   // Can be used as a target for GPU rendering
  tfAutoMipMap     = 32;   // MIPMAPs are generated automatically, don't need to fill manually
  tfNoLock         = 64;   // No need to lock the texture to access its data
  tfClamped        = $80;  // By default texture coordinates are clamped (otherwise - not clamped)
  tfVidmemOnly     = $0100; // Texture uses only VRAM (download operation is required to access pixel data)
  tfSysmemOnly     = $0200; // Texture uses only System RAM (can't be used by GPU)
  tfTexture        = $0400; // Texture corresponds to a texture object of the underlying API
  tfScaled         = $0800; // scale factors are used
  tfCloned         = $1000; // Texture object is cloned from another, so don't free any underlying resources
  tfPixelated      = $2000; // No interpolation allowed for sampling this texture
  tfDirty          = $4000; // Texture is "dirty" - internal storage was modified
  tfThreadLocal    = $8000; // Texture is owned by a single thread/window, must not be shared
  tfImmutable      = $10000; // Texture content is immutable after initial upload
  // Flags of the texture object itself, not of its storage: they stay with the object
  // when the storage is exchanged (TTexture.ExchangeContent)
  HANDLE_CAPS = tfImmutable or tfCloned or tfThreadLocal or tfRenderTarget;

 type
  // Texture filtering mode
  TTexFilter=(fltUndefined,    // filter not defined
              fltNearest,      // no interpolation
              fltBilinear,     // bilinear interpolation
              fltTrilinear,    // trilinear interpolation (mip-maps only)
              fltAnisotropic); // anisotropic filtering (mip-maps only)

  // Access mode for locked resources
  TLockMode=(lmReadOnly,       //< read-only (do not invalidate data when unlocked)
             lmReadWrite,      //< read+write (invalidate the whole area)
             lmWriteOnly,      //< write-only (don't download texture data into the internal storage)
             lmCustomUpdate);  //< read+write, do not invalidate anything (AddDirtyRect is required, partial lock is not allowed in this case)

  TTexture=class; // forward (referenced by the pixel-fill callbacks below)
  TTextures=array of TTexture;
  // How a file image was loaded: enough to load it again (see ImageTools.ReloadFileImages)
  TImageLoadRequest=record
   ref:String8;              // the reference as requested (with or without extension)
   flags:cardinal;           // liffXXX loading flags
   format:TImagePixelFormat; // forced pixel format, ipfNone - as in the file
  end;
  // Callback computing the ARGB color of a single texel. The texture is passed
  // so the callback can derive normalized u,v from x,y and tex.width/height when needed.
  TPixelFillFunc=function(tex:TTexture;x,y:integer):cardinal;             // plain function
  TPixelFillMethod=function(tex:TTexture;x,y:integer):cardinal of object; // method (e.g. of a scene)

  // Base abstract class: texture or texture region
  TTexture=class(TNamedObject)
   pixelFormat:TImagePixelFormat;
   width,height:integer; // dimension (in virtual pixels)
   left,top:integer; // position in the underlying resource
   mipmaps:byte; // highest available mip-map level
   caps:cardinal; // capability flags
   refCounter:integer; // extra holders of this object: shared handles (LoadImage) and clones; 0 = single owner
   parent:TTexture;    // reference to a parent texture
   // These properties are valid when texture is ONLINE (uploaded)
   u1,v1,u2,v2:single; // texture coordinates
   stepU,stepV:single; // halved texel step
   // These properties are valid when texture is LOCKED
   data:pointer;   // raw data
   pitch:integer;  // offset to next scanline

   // Take one more (strong) reference to this texture: the same object is returned,
   // release it with FreeImage like any other reference. Not for thread-local textures.
   function AddRef:TTexture;
   // Create cloned image (separate object referencing the same image data). Original image can't be destroyed unless all its clones are destroyed
   procedure CloneFrom(from:TTexture); virtual;
   function Clone:TTexture; // Clone this texture and return the cloned instance
   function ClonePart(part:TRect):TTexture; // Create cloned instance for part of this texture
   procedure Clear(color:cardinal=$808080); virtual; abstract; // Clear and fill the texture with given color
   procedure ClearPart(mipLevel:byte;x,y,width,height:integer;color:cardinal=$808080); virtual; abstract; // clear part of texture
   // Fill the top mip level by calling a callback for every texel (convenient but not fast).
   // Locks/unlocks the texture automatically if it is not already locked. ARGB/XRGB formats only.
   procedure Fill(func:TPixelFillFunc); overload;
   procedure Fill(func:TPixelFillMethod); overload;
   // Define (upload) texture content directly from user defined storage
   procedure Upload(pixelData:pointer;pitch:integer;pixelFormat:TImagePixelFormat); overload; virtual; abstract;
   procedure Upload(mipLevel:byte;pixelData:pointer;pitch:integer;pixelFormat:TImagePixelFormat); overload; virtual; abstract;
   procedure UploadPart(mipLevel:byte;x,y,width,height:integer;pixelData:pointer;pitch:integer;pixelFormat:TImagePixelFormat); virtual; abstract;
   // Access to the internal texture content
   procedure Lock(miplevel:byte=0;mode:TLockMode=lmReadWrite;rect:PRect=nil); virtual; abstract; // mipLevel=0..mipMaps
   procedure LockLayer(layer:integer;miplevel:byte=0;mode:TLockMode=lmReadWrite;rect:PRect=nil); virtual; abstract; // lock layer of 3D texture or texture array
   function GetLayer(layer:integer):TTexture; virtual; abstract; // return 2D texture object of a texture array element or 3D texture layer
   function GetRawImage:TRawImage; virtual; abstract; // Create RAW image for the topmost MIP level (when locked)
   function IsLocked:boolean;
   procedure MakeImmutable; virtual; // mark texture immutable after initial upload
   procedure Unlock; virtual; abstract;
   procedure AddDirtyRect(rect:TRect;level:integer=0); virtual; abstract; // mark area to update (when locked with mode=lmCustomUpdate)
   // Utilities
   procedure GenerateMipMaps(count:byte); virtual; abstract; // generate mip-map images
   function HasFlag(flag:cardinal):boolean; inline;
   function ScanLine(y:integer):pointer; inline;
   function PixelPtr(x,y:integer):pointer; inline;
   // Limit texture filtering to the specified mode (i.e. bilinear mode disables mip-mapping)
   procedure SetFilter(filter:TTexFilter); virtual; abstract;
   function Size:TSize; // (width,height)
   procedure Dump(filename:string8=''); virtual; abstract; // for debug purposes

   // Source key of an image reference: separators fixed, images root (defaultImagesDir)
   // or the executable directory stripped, extension and letter case kept.
   // Pure string function: any reference to the same file gives the same key without
   // touching the disk. A key with extension names a file, a key without one names an
   // image (any of its files). Lookup is case-insensitive; files that differ only by
   // letter case are not allowed.
   class function SourceKey(const ref:String8):String8; static;
   // Find a loaded texture by its source. A reference with extension finds the texture
   // loaded from that file; one without extension finds the image loaded from any of
   // its files. The source registry is an index, not an owner: it lists every texture
   // with a source, mutable or not.
   class function FindByFile(const ref:String8):TTexture; virtual;

   // --- Content replacement (file image reload, see ImageTools.ReloadFileImages) ---
   // A standalone texture can take the storage of a private donor texture (just loaded,
   // no other holders or views): the object, its holders, name and views stay, the
   // pixels, size and format are the donor's. Render thread only, between frames,
   // single render window. Two steps, so a batch of textures is replaced all or nothing:
   // Prepare validates the pair and makes the donor GPU-ready, raises on any problem and
   // changes nothing visible; ExchangeContent then does not fail. The donor gets the old
   // storage and is released by the caller.
   procedure PrepareContentExchange(donor:TTexture); virtual;
   procedure ExchangeContent(donor:TTexture); virtual;
   // Remember how this standalone texture was loaded from a file and list it among
   // the file images
   procedure SetLoadRequest(const request:TImageLoadRequest);
   // Live standalone file images (with a load request). Textures are freed on the
   // render thread only, so the snapshot stays valid there until the caller frees some
   class function FileImages:TTextures; static;
   // Point several textures to new source keys at once: all of them leave the source
   // index first, then the immutable ones enter it before the mutable ones, so a private
   // copy never becomes the indexed owner of a key
   class procedure ChangeSources(const textures:TTextures;const keys:Strings8); static;

  protected
   fSrc:string8; // storage for property src
   locked:integer; // lock counter
   fLoadRequest:TImageLoadRequest;
   fileIndex:integer; // position in the file image list +1, 0 - not listed
   views:TTextures; // live clones of this (root) texture
   wholeView:boolean; // a clone that covers the whole root and follows its size
   class function ClassHash:pointer; override;
   procedure SetSource(filename:string8);
   procedure Unindex;
   procedure AttachView; // list this clone at its parent (once it is fully built)
   procedure DetachView; // before the clone releases its parent
   procedure RefreshViews(oldWidth,oldHeight:integer);
   procedure ForgetBindings; virtual; // backend: drop cached bindings of this texture and its views
  public
   destructor Destroy; override;
   property src:String8 read fSrc write SetSource; // source key of the loaded file (with extension), see SourceKey
   property loadRequest:TImageLoadRequest read fLoadRequest;
  end;

 // Base class for shader object
 TShader=class(TNamedObject)
  // Set uniform value
  procedure SetUniform(name:String8;value:integer); overload; virtual; abstract;
  procedure SetUniform(name:String8;value:single); overload; virtual; abstract;
  procedure SetUniform(name:String8;const value:TVec2); overload; virtual; abstract;
  procedure SetUniform(name:String8;const value:TVec3); overload; virtual; abstract;
  procedure SetUniform(name:String8;const value:TQuat); overload; virtual; abstract;
  procedure SetUniform(name:String8;const value:TMat4d); overload; virtual; abstract;
  procedure SetUniform(name:String8;const value:TMat4); overload; virtual; abstract;
  class function VectorFromColor3(color:cardinal):TVec3;
  class function VectorFromColor(color:cardinal):TQuat;
 protected
  class function ClassHash:pointer; override;
 end;

 TBufferUsage=(buStatic,   // filled once, used many times
               buDynamic,  // filled many times, used many times
               buTemporary);  // one-time buffer: filled once, used once

 TEngineBuffer=class(TObjectEx)
  sizeInBytes:integer;
  caps:cardinal;
  ownerThread:TThreadIdent;
  // Optional debug label for GPU object naming (NSight/RenderDoc/etc).
  // Filled by higher-level systems that know semantic ownership.
  debugName:String8;
  procedure MakeImmutable; virtual;
  function IsImmutable:boolean; inline;
  function IsThreadLocal:boolean; inline;
  procedure AssertThreadOwner(const opName:string8); inline;
  procedure PublishUpdate; virtual; // producer-side sync point for shared mutable buffers
  procedure WaitForPublish; virtual; // consumer-side wait for latest published update
  procedure ResetPublishState; virtual;
  // RW-lock protocol: acquire before accessing buffer data, release after.
  // Used in multi-window mode to prevent concurrent upload and render.
  procedure BeginRead; inline;  // shared read lock (concurrent renders allowed)
  procedure EndRead; inline;
  procedure BeginWrite; inline; // exclusive write lock (blocks until all readers done)
  procedure EndWrite; inline;
  constructor Create(flags:cardinal=0);
  destructor Destroy; override;
 protected
  rwLock:TRWLock;
  procedure EnsureWritable(const opName:string8); inline;
 end;

 TVertexBuffer=class(TEngineBuffer)
  count:integer;
  layout:TVertexLayout;   // legacy packed layout (empty for raw/GpuMesh buffers)
  strideBytes:integer;    // bytes per vertex; source of truth for sizing/upload
  constructor Create(layout:TVertexLayout;count:integer;flags:cardinal=0); overload;
  // Layout-less buffer: caller owns the byte layout (R-19 TGpuMesh path).
  constructor Create(strideBytes,count:integer;flags:cardinal=0); overload;
  procedure Upload(fromVertex,numVertices:integer;vertexData:pointer); virtual; abstract;
  procedure Resize(newCount:integer); virtual; abstract;
 end;

 TIndexBuffer=class(TEngineBuffer)
  count:integer;
  bytesPerIndex:integer; // 2 or 4
  constructor Create(count:integer;elementSize:integer;flags:cardinal=0);
  procedure Upload(fromIndex,numIndices:integer;indexData:pointer); virtual; abstract;
  procedure Resize(newCount:integer); virtual; abstract;
 end;

var
 // Set to true when multiple render windows/threads are active.
 // Enables RW-lock synchronization on shared mutable textures.
 // Single-window mode: false (default) — all sync is bypassed for zero overhead.
 multiWindowMode:boolean=false;

// Returns true when a write operation on tex must acquire RW-lock.
// False for: single-window mode, thread-local textures, immutable textures.
function NeedSyncForWrite(tex:TTexture):boolean; inline;

// Returns true when a metadata read on tex must acquire read-lock.
// Same conditions as NeedSyncForWrite: only shared mutable textures in multi-window mode.
function NeedSyncForRead(tex:TTexture):boolean; inline;

// Returns true when buffer upload/resize/use must hold RW-lock.
// Only meaningful in multi-window mode; single-window mode: always false.
function NeedSyncForBuffer(buf:TEngineBuffer):boolean; inline;
function NeedSyncForBufferRead(buf:TEngineBuffer):boolean; inline;
function NeedSyncForBufferWrite(buf:TEngineBuffer):boolean; inline;

 var
  defaultImagesDir:String8='Images\'; // default folder to load images from (relative names are resolved against it)

implementation
 uses Apus.Lib, Apus.Strings;

 var
  texturesHash:TObjectHash;  // Search hash: name->texture
  texFileHash:TObjectMap;    // Search hash: filename->texture
  shadersHash:TObjectHash;   // Search hash: name->shader
  fileImageList:TTextures;   // standalone textures with a load request, see TTexture.fileIndex
  fileImageCount:integer;
  viewLock:TLock;            // file image list and view lists (inner to GLTexMan)

function NeedSyncForWrite(tex:TTexture):boolean;
begin
 result:=multiWindowMode and
         not Bits.HasAny(tex.caps,tfThreadLocal or tfImmutable);
end;

function NeedSyncForRead(tex:TTexture):boolean;
begin
 result:=multiWindowMode and
         not Bits.HasAny(tex.caps,tfThreadLocal or tfImmutable);
end;

function NeedSyncForBuffer(buf:TEngineBuffer):boolean;
begin
 result:=NeedSyncForBufferRead(buf) or NeedSyncForBufferWrite(buf);
end;

function NeedSyncForBufferRead(buf:TEngineBuffer):boolean;
begin
 result:=multiWindowMode and (buf<>nil) and
   not buf.IsThreadLocal and
   not buf.IsImmutable;
end;

function NeedSyncForBufferWrite(buf:TEngineBuffer):boolean;
begin
 result:=multiWindowMode and (buf<>nil) and
   not buf.IsThreadLocal and
   not buf.IsImmutable;
end;

{ TEngineBuffer }

constructor TEngineBuffer.Create(flags:cardinal=0);
begin
 inherited Create;
 caps:=0;
 if Bits.HasAny(flags,abThreadLocal) then begin
  Bits.SetFlag(caps,bfThreadLocal);
  ownerThread:=GetCurrentThreadID;
 end else
  ownerThread:=0;
 if Bits.HasAny(flags,abImmutable) then
  Bits.SetFlag(caps,bfImmutable);
 if Bits.HasAny(flags,abShared) then
  Bits.SetFlag(caps,bfSharedHint);
 rwLock.Init;
end;

destructor TEngineBuffer.Destroy;
begin
 rwLock.Cleanup;
 inherited;
end;

procedure TEngineBuffer.BeginRead;
begin
 AssertThreadOwner('BeginRead');
 if NeedSyncForBufferRead(self) then rwLock.EnterRead;
end;

procedure TEngineBuffer.EndRead;
begin
 if NeedSyncForBufferRead(self) then rwLock.LeaveRead;
end;

procedure TEngineBuffer.BeginWrite;
begin
 AssertThreadOwner('BeginWrite');
 EnsureWritable('BeginWrite');
 if NeedSyncForBufferWrite(self) then rwLock.EnterWrite;
end;

procedure TEngineBuffer.EndWrite;
begin
 if NeedSyncForBufferWrite(self) then rwLock.LeaveWrite;
end;

procedure TEngineBuffer.EnsureWritable(const opName:string8);
begin
 if IsImmutable then
  raise EWarning.Create('Attempt to modify immutable buffer: '+debugName+' ('+opName+')');
end;

procedure TEngineBuffer.MakeImmutable;
begin
 Bits.SetFlag(caps,bfImmutable);
end;

function TEngineBuffer.IsImmutable:boolean;
begin
 result:=Bits.HasAny(caps,bfImmutable);
end;

function TEngineBuffer.IsThreadLocal:boolean;
begin
 result:=Bits.HasAny(caps,bfThreadLocal);
end;

procedure TEngineBuffer.AssertThreadOwner(const opName:string8);
begin
 if not IsThreadLocal then exit;
 ASSERT(ownerThread=GetCurrentThreadID,'Thread-local buffer ownership violation in '+opName);
end;

procedure TEngineBuffer.PublishUpdate;
begin
 // Backend-specific implementation is optional.
end;

procedure TEngineBuffer.WaitForPublish;
begin
 // Backend-specific implementation is optional.
end;

procedure TEngineBuffer.ResetPublishState;
begin
 // Backend-specific implementation is optional.
end;

 procedure TTexture.CloneFrom(from:TTexture);
  begin
   PixelFormat:=from.PixelFormat;
   left:=from.left;
   top:=from.top;
   width:=from.width;
   height:=from.height;
   u1:=from.u1; v1:=from.v1;
   u2:=from.u2; v2:=from.v2;
   stepU:=from.stepU; stepV:=from.stepV;
   mipmaps:=from.mipmaps;
   caps:=from.caps or tfCloned;
   if (from.name<>'') and (from.name[1]='_') then
    name:=from.name+'_clone' // non-unique label: clones never enter the name registry
   else
    name:='_'+from.name+'_clone';
   if from.parent<>nil then
    parent:=from.parent
   else
    parent:=from;
   inc(parent.refCounter); // decremented in ResManGL.FreeImage when clone is freed
   fSrc:=from.src; // clones keep the source path, but must not override file lookup entries
   wholeView:=(from.parent=nil) or from.wholeView;
  end;

function TTexture.AddRef:TTexture;
 begin
  if self<>nil then Atomic.Inc(refCounter); // decremented in ResManGL.FreeImage
  result:=self;
 end;

function TTexture.HasFlag(flag:cardinal): boolean;
begin
 result:=caps and flag>0;
end;

function TTexture.ScanLine(y:integer):pointer;
begin
 result:=pointer(UIntPtr(data)+UIntPtr(y*pitch));
end;

function TTexture.PixelPtr(x,y:integer):pointer;
begin
 ASSERT((x>=0) and (y>=0) and (x<width) and (y<height));
 result:=pointer(UIntPtr(data)+UIntPtr(y*pitch+x*(pixelSize[pixelFormat] shr 3)));
end;

function TTexture.IsLocked:boolean;
begin
 result:=locked>0;
end;

procedure TTexture.Fill(func:TPixelFillFunc);
var
 x,y:integer;
 row:PCardinalRow;
 wasLocked:boolean;
begin
 ASSERT(pixelFormat in [ipfARGB,ipfXRGB],'Fill supports 32-bit ARGB/XRGB textures only: '+name);
 wasLocked:=IsLocked;
 if not wasLocked then Lock; // lock the top mip level
 try
  for y:=0 to height-1 do begin
   row:=PCardinalRow(ScanLine(y));
   for x:=0 to width-1 do
    row^[x]:=func(self,x,y);
  end;
 finally
  if not wasLocked then Unlock;
 end;
end;

procedure TTexture.Fill(func:TPixelFillMethod);
var
 x,y:integer;
 row:PCardinalRow;
 wasLocked:boolean;
begin
 ASSERT(pixelFormat in [ipfARGB,ipfXRGB],'Fill supports 32-bit ARGB/XRGB textures only: '+name);
 wasLocked:=IsLocked;
 if not wasLocked then Lock; // lock the top mip level
 try
  for y:=0 to height-1 do begin
   row:=PCardinalRow(ScanLine(y));
   for x:=0 to width-1 do
    row^[x]:=func(self,x,y);
  end;
 finally
  if not wasLocked then Unlock;
 end;
end;

procedure TTexture.MakeImmutable;
begin
 if IsLocked then
  raise EWarning.Create('Can''t make immutable while texture is locked: '+name);
 Bits.SetFlag(caps,tfImmutable);
end;

// Image key of a file key: the extension (last '.' after the last separator) stripped
function ImageKey(const fileKey:String8):String8;
 var
  i:integer;
 begin
  result:=fileKey;
  for i:=length(result) downto 1 do begin
   if result[i] in ['\','/'] then break;
   if result[i]='.' then begin
    SetLength(result,i-1);
    break;
   end;
  end;
 end;

// Remove this object from the source index: the file entry and the image entry, each
// only if it points to this texture (a private copy shares the keys but never replaces
// the first texture)
procedure TTexture.Unindex;
 var
  obj:TObject;
  key:String8;
 begin
  if fSrc='' then exit;
  if texFileHash.Get(fSrc,obj) and (obj=self) then texFileHash.Remove(fSrc);
  key:=ImageKey(fSrc);
  if (key<>fSrc) and texFileHash.Get(key,obj) and (obj=self) then texFileHash.Remove(key);
 end;

destructor TTexture.Destroy;
 var
  last:TTexture;
 begin
  if parent<>nil then DetachView; // a clone freed directly, not by FreeImage
  if fileIndex>0 then begin
   viewLock.Enter;
   try
    last:=fileImageList[fileImageCount-1];
    fileImageList[fileIndex-1]:=last;
    last.fileIndex:=fileIndex;
    dec(fileImageCount);
    fileImageList[fileImageCount]:=nil;
    fileIndex:=0;
   finally
    viewLock.Leave;
   end;
  end;
  Unindex;
  inherited;
 end;

procedure TTexture.AttachView;
 begin
  if parent=nil then exit;
  viewLock.Enter;
  try
   SetLength(parent.views,length(parent.views)+1);
   parent.views[high(parent.views)]:=self;
  finally
   viewLock.Leave;
  end;
 end;

procedure TTexture.DetachView;
 var
  i,n:integer;
 begin
  if parent=nil then exit;
  viewLock.Enter;
  try
   n:=high(parent.views);
   for i:=0 to n do
    if parent.views[i]=self then begin
     parent.views[i]:=parent.views[n];
     SetLength(parent.views,n);
     break;
    end;
  finally
   viewLock.Leave;
  end;
 end;

procedure TTexture.SetLoadRequest(const request:TImageLoadRequest);
 begin
  ASSERT(parent=nil,'Load request for a clone: '+name);
  fLoadRequest:=request;
  if fileIndex>0 then exit;
  viewLock.Enter;
  try
   if fileImageCount>=length(fileImageList) then
    SetLength(fileImageList,16+fileImageCount*2);
   fileImageList[fileImageCount]:=self;
   inc(fileImageCount);
   fileIndex:=fileImageCount;
  finally
   viewLock.Leave;
  end;
 end;

class function TTexture.FileImages:TTextures;
 begin
  viewLock.Enter;
  try
   result:=Copy(fileImageList,0,fileImageCount);
  finally
   viewLock.Leave;
  end;
 end;

class procedure TTexture.ChangeSources(const textures:TTextures;const keys:Strings8);
 var
  i,j,pass:integer;
 begin
  ASSERT(length(textures)=length(keys));
  for i:=0 to high(textures) do textures[i].Unindex;
  for pass:=0 to 1 do
   for i:=0 to high(textures) do
    if textures[i].HasFlag(tfImmutable)=(pass=0) then
     textures[i].SetSource(keys[i]);
  // views keep the key of their root as information
  viewLock.Enter;
  try
   for i:=0 to high(textures) do
    for j:=0 to high(textures[i].views) do
     textures[i].views[j].fSrc:=textures[i].fSrc;
  finally
   viewLock.Leave;
  end;
 end;

procedure TTexture.PrepareContentExchange(donor:TTexture);
 var
  i:integer;
  view:TTexture;
 begin
  if (donor=nil) or (donor=self) or (parent<>nil) or (donor.parent<>nil) or
     (donor.refCounter<>0) or (length(donor.views)>0) or IsLocked or donor.IsLocked or
     multiWindowMode or HasFlag(tfRenderTarget or tfThreadLocal) or
     donor.HasFlag(tfRenderTarget or tfThreadLocal) then
   raise EWarning.Create('Content exchange requires idle standalone textures: '+name);
  // cropped views keep their pixel bounds, so they must fit into the new content
  viewLock.Enter;
  try
   for i:=0 to high(views) do begin
    view:=views[i];
    if view.wholeView then continue;
    if (view.left+view.width>donor.width) or (view.top+view.height>donor.height) then
     raise EWarning.Create('Replacement is smaller than a live view of '+name);
   end;
  finally
   viewLock.Leave;
  end;
 end;

procedure TTexture.ExchangeContent(donor:TTexture);
 begin
  raise EWarning.Create('Content exchange is not supported by '+ClassName);
 end;

procedure TTexture.ForgetBindings;
 begin
 end;

// Views after the root got new storage: whole views take the new size, cropped views
// keep their pixel bounds; UVs, format and storage flags follow the root
procedure TTexture.RefreshViews(oldWidth,oldHeight:integer);
 var
  i:integer;
  view:TTexture;
 begin
  viewLock.Enter;
  try
   for i:=0 to high(views) do begin
    view:=views[i];
    if view.wholeView then begin
     view.width:=width;
     view.height:=height;
    end;
    view.pixelFormat:=pixelFormat;
    view.mipmaps:=mipmaps;
    view.caps:=(view.caps and HANDLE_CAPS) or (caps and not HANDLE_CAPS);
    view.stepU:=stepU; view.stepV:=stepV;
    view.u1:=u1+view.left*stepU*2;
    view.v1:=v1+view.top*stepV*2;
    view.u2:=view.u1+view.width*stepU*2;
    view.v2:=view.v1+view.height*stepV*2;
   end;
  finally
   viewLock.Leave;
  end;
 end;

procedure TTexture.SetSource(filename:string8);
 var
  key:String8;
 begin
  Unindex;
  fSrc:=filename;
  // Clones keep the key as information but don't index
  if (fSrc='') or (parent<>nil) or HasFlag(tfCloned) then exit;
  // Two entries: the file itself and the image (for references without extension).
  // An existing entry is never replaced: the first texture loaded from a file (or,
  // for the image entry, from any of its files) stays the one FindByFile returns
  if not texFileHash.HasKey(fSrc) then texFileHash.Put(fSrc,self);
  key:=ImageKey(fSrc);
  if (key<>fSrc) and not texFileHash.HasKey(key) then texFileHash.Put(key,self);
 end;

function TTexture.Size:TSize;
 begin
  result.cx:=width;
  result.cy:=height;
 end;

class function TTexture.ClassHash: pointer;
 begin
  result:=@texturesHash;
 end;

function TTexture.Clone:TTexture;
 begin
  result:=ClassType.Create as TTexture;
  result.CloneFrom(self);
  result.AttachView;
 end;

function TTexture.ClonePart(part:TRect): TTexture;
 begin
  result:=ClassType.Create as TTexture;
  result.CloneFrom(self);
  result.wholeView:=false;
  result.left:=left+part.Left;
  result.top:=top+part.Top;
  result.width:=part.Width;
  result.height:=part.Height;
  result.u1:=u1+part.left*stepU*2;
  result.u2:=u1+part.right*stepU*2;
  result.v1:=v1+part.top*stepV*2;
  result.v2:=v1+part.bottom*stepV*2;
  result.AttachView; // listed only with its final bounds
 end;

class function TTexture.SourceKey(const ref:String8):String8;
 var
  i:integer;
  root:String8;
 begin
  result:=Files.FixName(ref);
  // strip the images root or the executable directory (case-insensitive prefix match)
  root:=Files.FixName(defaultImagesDir);
  if (root<>'') and result.StartsWith(root,true) then
   delete(result,1,length(root))
  else begin
   root:=Files.FixName(String8(ParamStr(0)));
   for i:=length(root) downto 1 do
    if root[i] in ['\','/'] then begin
     SetLength(root,i);
     break;
    end;
   if (root<>'') and result.StartsWith(root,true) then
    delete(result,1,length(root));
  end;
 end;

class function TTexture.FindByFile(const ref:String8):TTexture;
var
 obj:TObject;
begin
 if texFileHash.Get(SourceKey(ref),obj) then
  result:=obj as TTexture
 else
  result:=nil;
end;

{ TShader }
class function TShader.ClassHash: pointer;
 begin
  result:=@shadersHash;
 end;

class function TShader.VectorFromColor(color:cardinal):TQuat;
 var
  c:PARGBColor;
 begin
  c:=@color;
  result.x:=c.r/255;
  result.y:=c.g/255;
  result.z:=c.b/255;
  result.w:=c.a/255;
 end;

class function TShader.VectorFromColor3(color:cardinal): TVec3;
 var
  c:PARGBColor;
 begin
  c:=@color;
  result.x:=c.r/255;
  result.y:=c.g/255;
  result.z:=c.b/255;
 end;


{ TVertexBuffer }

constructor TVertexBuffer.Create(layout:TVertexLayout;count:integer;flags:cardinal=0);
 begin
  inherited Create(flags);
  self.layout:=layout;
  self.count:=count;
  strideBytes:=layout.stride;
  sizeInBytes:=count*strideBytes;
 end;

constructor TVertexBuffer.Create(strideBytes,count:integer;flags:cardinal=0);
 begin
  inherited Create(flags);
  self.count:=count;
  self.strideBytes:=strideBytes;
  sizeInBytes:=count*strideBytes;
 end;

{ TIndexBuffer }

constructor TIndexBuffer.Create(count,elementSize:integer;flags:cardinal=0);
 begin
  inherited Create(flags);
  self.count:=count;
  self.bytesPerIndex:=elementSize;
  sizeInBytes:=count*elementSize;
 end;

initialization
 viewLock.Init('TextureViews',170);
end.