Apus.Engine.ImageTools.pas

// Image loading functions implementation (extracted from EngineTools)
//
// Copyright (C) 2020 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.ImageTools;
interface
 uses Apus.Core, Apus.Images, Apus.Engine.API, Apus.Engine.Resources,
  Apus.Threads;

 // Load an image from a file into a texture (in the optimal format, if not specified explicitly)
 // If sysmem=true, it is loaded into a surface in system memory
 // function LoadImageFromFile(fname:string;mtwidth:integer=0;mtheight:integer=0;sysmem:boolean=false;
 //           ForceFormat:TImagePixelFormat=ipfNone):TTexture;
 function LoadImageFromFile(fname:String8;flags:cardinal=0;ForceFormat:TImagePixelFormat=ipfNone):TTexture;

 // Read the live file images again through the current Files providers (e.g. after
 // switching a data layer such as a graphics theme). Texture objects stay: their
 // holders, names and views see the new pixels, size and format. A reference without
 // extension selects its file again (Files.SelectFile), so the extension may change.
 // Only images whose source key starts with prefix (see TTexture.SourceKey), all if ''.
 // All or nothing: every replacement is decoded and uploaded before any image changes;
 // on failure (missing/corrupt file, a cropped view outside the new size) it raises and
 // the images keep their content. Returns the number of images reloaded.
 // Render thread, between frames, single render window; the caller suspends image
 // creation/destruction and the preload queue (ImgLoadQueue) for the time of the call.
 // Not reloaded: images taken from atlases, textures that were not loaded from a file.
 function ReloadFileImages(const prefix:String8=''):integer;

 // (Re)load texture from an image file. defaultImagesDir is used if path is relative
 // Default flags can be used from defaultLoadImageFlags
 procedure LoadImage(var img:TTexture;fName:String8;flags:cardinal=liffDefault);

 // Save image to file (mostly for debug purposes)
 procedure SaveImage(img:TTexture;fName:String8);

 // Create image from STR format
 function CreateImageFromString(st:string8;padding:integer=0;flags:cardinal=0):TTexture;

 // Create a new texture from a part of the given one (copy pixel data). The new texture is placed in
 // renderable memory, while the source can be anywhere
 function CreateSubImage(source:TTexture;x,y,width,height:integer;flags:integer=0):TTexture;

 // Special case - a copy of the whole image (the data is copied)
 function CreateImageCopy(source:TTexture):TTexture;

 // Wrapper for CopyRect
 procedure CopyImageRect(source,dest:TTexture;sx,sy,width,height,targetX,targetY:integer);

 // load a texture with mipmaps from a file (DDS is looked up first, then other formats)
 // texture size must be a power of 2
 // if the file has no mipmaps, they are generated
 // if the format of the loaded image differs from the final one, a DDS in the required format is saved
 function LoadTexture(fname:string8;downscale:single;format:TImagePixelFormat=ipfNone;saveDDS:boolean=true):TTexture;

 // Load a texture atlas
 // After that, loading an image that is already in the atlas creates a texture object referencing
 // the atlas instead of loading it from a file
 // Not thread-safe! Don't load atlases in one thread and create images in other thread
 procedure LoadAtlas(fname:string8;scale:single=1.0);

 // Set image as render target for FastGFX drawing operations (lock if not locked) Don't forget to unlock!
 procedure EditImage(tex:TTexture);

 // Change image size while keeping its texture space (resolution change)
// procedure ScaleImage(image:TTexture;scaleX,scaleY:single);

 // View on the given area (x2,y2 inclusive) of an image: a clone sharing the
 // storage; the source handle is not modified. Free the result like any texture.
 function CropImage(image:TTexture;x1,y1,x2,y2:integer):TTexture;

 // Shrink an xRGB image by cutting out:
 //   vertical stripes x1..x2-1, x3..x4-1
 //   horizontal stripes y1..y2-1, y3..y4-1
 // The parts are blended (dissolve) over a depth of overlap pixels
 // Stripes may have zero width (x1=x2), but all coordinates must be ordered (0 < x1 <= x2 < x3 <= x4 < width)
 function ShrinkImage(image:TTexture;x1,x2,x3,x4,y1,y2,y3,y4:integer;overlap:integer):TTexture;

 // Expands image this way: where y1..y2 = 456 band, and x1..x2 is 258 band (can also be used for shrinking)
 //  123      1223
 //  456  =>  4556
 //  789      4556
 //           7889
 function ExpandImage(image:TTexture;x1,x2,y1,y2:integer;overlap:integer):TTexture; overload;

 // Create a stretched/shrunk copy of an image (everything in ARGB)
 function ResampleImage(image:TTexture;newWidth,newHeight:integer;sysMem:boolean=false):TTexture;

 // strength: 0..256 (ARGB and xRGB only!)
 procedure SharpenImage(image:TTexture;strength:integer);

 // brightness: -1..1 (0 - no change), contrast: 0..1.., saturation 0..1.. (1 - no change)
 procedure AdjustImage(image:TTexture;brightness,contrast,saturation:single);

 procedure ImageHueSaturation(image:TTexture;hue,saturation:single);

 // Build a tangent-space normal map texture from a height-map texture (ARGB/xRGB, height = pixel luminance).
 // Returns a new ARGB texture of the same size. See Apus.GfxFilters.HeightToNormalMap for strength/wrap semantics.
 function NormalMapFromHeight(heightMap:TTexture;strength:single=2.0;wrap:boolean=true):TTexture;

 function MTFlags(mtWidth,mtHeight:integer):cardinal; // build liffMxxx flags for given width/height values


implementation
uses SysUtils, Apus.Lib, Apus.Strings, Apus.Geom3D, Types,
   Apus.GfxFormats, Apus.Engine.ImgLoadQueue, Apus.FastGFX, Apus.Colors,
   Apus.GfxFilters, Apus.Compress;

const
  max_subimages = 5000;

type
  TMipLevelData=record
    width,height:integer;
    pitch:integer;
    data:PByte;
  end;

var
  atlases:array[1..50] of TTexture;
  aCount:integer;
  // Atlas subimages
  aImages:array[1..max_subimages] of TTexture;
  aFiles:array[1..max_subimages] of String8; // uppercase, no extension
  aHash:array[1..max_subimages] of cardinal;
  aSubCount:integer;

  // "file name" -> cardinal(TJpegImage) - for jpeg preloading
  jpegImageHash:THash;

var
 loadingTime:integer; // total image loading time in ms
 loadingJPEGTime:integer; // total JPEG loading time in ms

var
 defaultLoadImageFlags:cardinal=0;

(*
procedure AddJPEGImage(filename:string;obj:TObject);
begin
 cSect.Enter;
 try
  jpegImageHash.Put(filename,cardinal(obj),true);
  Log.Msg('JPEG image added for '+filename);
 finally
  cSect.Leave;
 end;
end;

function GetJPEGImage(filename:string):TObject;
var
 c:cardinal;
begin
 result:=nil;
 EnterCriticalSection {TODO: use TLock.Enter}(cSect);
 try
  c:=jpegImageHash.Get(filename);
  if c>0 then begin
   result:=TObject(c);
   Log.Msg('Preloaded JPEG image found in hash');
  end;
 finally
  LeaveCriticalSection {TODO: use TLock.Leave}(cSect);
 end;
end; *)


// adjust the pixel format to one supported by the system
procedure AdjustFormat(var ForceFormat:TImagePixelFormat);
begin
 {$IFDEF OPENGL}
  case ForceFormat of
   ipfXRGB,ipfRGB:forceFormat:=ipfARGB;
   ipfARGB,ipf4444,ipf4444r,ipf565,ipf1555,ipf555,ipfDXT1,ipfDXT3,ipfDXT5,ipfPVRTC:exit;
   ipf8bit:forceFormat:=ipfARGB;
   ipfA8,ipfMono8:; // keep as-is
   else
    raise EError.Create('Failed to choose valid pixel format for '+PixFmt2Str(ForceFormat));
  end;
 {$ENDIF}
end;

function ExtractFileExt8(const fname:String8):String8;
var
  i:integer;
begin
  for i:=System.Length(fname) downto 1 do begin
    if (fname[i]='\') or (fname[i]='/') then break;
    if fname[i]='.' then begin
      result:=System.Copy(fname,i,System.Length(fname)-i+1);
      exit;
    end;
  end;
  result:='';
end;

function ExtractFilePath8(const fname:String8):String8;
var
  i:integer;
begin
  for i:=System.Length(fname) downto 1 do
    if (fname[i]='\') or (fname[i]='/') then begin
      result:=System.Copy(fname,1,i);
      exit;
    end;
  result:='';
end;


procedure NormalizeFName(var fname:string8);
var
  ext:string8;
begin
  fname:=fname.ToUpper;
  ext:=ExtractFileExt8(fname);
  if ext<>'' then fname:=fname.Replace(ext,'');
  {$IFDEF IOS}
  fname:=fname.ReplaceAll('\','/');
  {$ENDIF}
end;

procedure LoadAtlas(fname:string8;scale:single=1.0);
var
  lines:Strings8;
  i,x,y,w,h,aw,ah:integer;
  img,atlas:TTexture;
  st,path:String8;

 // Take the next whitespace-separated integer from the line
 function NextInt(var line:String8):integer;
  var
   p:integer;
  begin
   line:=line.TrimLeft;
   p:=pos(' ',line);
   if p=0 then p:=length(line)+1;
   result:=Conv.ToInt(copy(line,1,p-1));
   delete(line,1,p-1);
  end;

begin
 try
  path:=ExtractFilePath8(fname);
  lines:=Files.LoadAsString(Files.FixName(fname+'.atl')).ReplaceAll(#9,' ').SplitLines;
  st:=lines[0];
  aw:=NextInt(st); ah:=NextInt(st);
  if aCount>=high(atlases) then
   raise EError.Create('Too many atlases loaded: '+fname);
  inc(aCount);
  atlas:=LoadImageFromFile(fname);
  atlases[aCount]:=atlas;
  for i:=1 to high(lines) do begin
   st:=lines[i];
   x:=NextInt(st); y:=NextInt(st); w:=NextInt(st); h:=NextInt(st);
   st:=st.Trim;
   if (st='') or (w=0) or (h=0) then continue;
   if aSubCount>=high(aImages) then
    raise EError.Create('Too many atlas subimages in '+fname);
   inc(aSubCount);
   img:=atlas.ClonePart(Rect(x,y,x+w,y+h));
   aImages[aSubCount]:=img;
   st:=path+st;
   NormalizeFName(st);
   aFiles[aSubCount]:=st;
   aHash[aSubCount]:=strHash(st);
   if length(st)>15 then st:=copy(st,length(st)-14,15);
   img.name:='_'+Str8(st); // non-unique label (clones never enter the name registry)
//   if scale<>1.0 then ScaleImage(img,scale,scale);
  end;
 except
  on e:Exception do raise EError.Create('Failed to load atlas '+fname+': '+ExceptionMsg(e));
 end;
end;

function LoadTexture(fname:string8;downscale:single;format:TImagePixelFormat=ipfNone;saveDDS:boolean=true):TTexture;
var
 i,j:integer;
 tex:TTexture;
 buf:ByteArray;
 conversion:boolean;
 width,height:integer;
 levels:array[0..12] of TMipLevelData; // DDS mip levels staged for upload
 sp,dp:PByte;
 ftype:integer;
begin
 // TODO: either implement the advertised conversion/downscale/saveDDS pipeline
 // or narrow this API to the DDS-only path that is actually supported.
 fname:=fname.ToUpper;
 ftype:=0;
 if pos('.DDS',fname)>0 then ftype:=1;
 if pos('.',fname)=0 then begin
  if Files.Exists(fname+'.dds') then begin
   fname:=fname+'.dds'; ftype:=1;
  end;
 end;
 if ftype=0 then raise EError.Create('Unsupported texture type: '+fname);
 // stage 1 - load the source file and its parameters into a buffer
 if ftype=1 then begin
  // load DDS
  buf:=Files.LoadAsBytes(fname);
  CheckImageFormat(buf);
  if format=ipfNone then format:=imgInfo.format;
  AdjustFormat(format);
  conversion:=(format<>imginfo.format) or (imgInfo.miplevels<3);
  if conversion then
   raise EError.Create('LoadTexture conversion path is not implemented safely for '+fname);
  if imgInfo.miplevels>length(levels) then
   raise EError.Create('Too many mip levels in '+fname+': '+IntToStr(imgInfo.miplevels));
  if not conversion then begin
   width:=imgInfo.width;
   height:=imgInfo.height;
   if format in [ipfDXT1..ipfDXT3] then begin
    width:=width div 4;
    height:=height div 4;
   end;
   sp:=@buf[0]; inc(sp,128);
   for i:=0 to imginfo.miplevels-1 do begin
    if width=0 then width:=1;
    if height=0 then height:=1;
    levels[i].width:=width;
    levels[i].height:=height;
    levels[i].data:=sp;
    levels[i].pitch:=width*pixelSize[format] div 8;
    inc(sp,levels[i].pitch*height);
    width:=width div 2; height:=height div 2;
   end;
  end; // conversion
 end else
 /// TODO: load other file types
 ;
 // stage 2 - create the texture
 tex:=AllocImage(imginfo.width,imginfo.height,format,
   aiTexture+aiAutoMipmap+aiPow2,fname) as TTexture;

 // stage 3 - upload data into the texture
 for i:=0 to tex.mipmaps-1 do begin
  // upload i-th level
  tex.Lock(i);
  // copy levels[i] content
  sp:=levels[i].data;
  dp:=tex.data;
  for j:=0 to levels[i].height-1 do begin
   move(sp^,dp^,levels[i].pitch);
   inc(sp,levels[i].pitch);
   inc(dp,tex.pitch);
  end;
  tex.Unlock;
 end;
 result:=tex;
end;

function NormalMapFromHeight(heightMap:TTexture;strength:single;wrap:boolean):TTexture;
begin
 ASSERT(heightMap.PixelFormat in [ipfARGB,ipfxRGB]);
 result:=AllocImage(heightMap.width,heightMap.height,ipfARGB,aiTexture,heightMap.name+'_nm') as TTexture;
 heightMap.Lock(0,lmReadOnly);
 result.Lock;
 try
  HeightToNormalMap(heightMap.data,heightMap.pitch, result.data,result.pitch,
    heightMap.width,heightMap.height, strength,wrap);
 finally
  result.Unlock;
  heightMap.Unlock;
 end;
end;

function MTFlags(mtWidth,mtHeight:integer):cardinal;
begin
 if mtWidth<128 then mtWidth:=128;
 if mtHeight<128 then mtHeight:=128;
 result:=(NextPow2(mtWidth)-7) shl 16+(NextPow2(mtHeight)-7) shl 20;
end;

function FindFileInAtlas(fname:String8):integer;
var
  i:integer;
  h:cardinal;
begin
  result:=0;
  NormalizeFName(fname);
  h:=strHash(fname);
  for i:=1 to aSubCount do
   if aHash[i]=h then
    if fname=aFiles[i] then begin
     result:=i; exit;
    end;
end;

// Find the image file for a name without extension. The provider chooses (Files.SelectFile):
// by default the newest candidate wins, on equal timestamps the earlier extension in the list
function FindProperFile(fname:String8;dontFail:boolean=false):String8;
 const
  EXTENSIONS:array[0..6] of String8=('.dds','.tga','.png','.webp','.jpg','.pvr','.txt');
 var
  i:integer;
  names:Strings8;
 begin
  names:=nil;
  for i:=0 to high(EXTENSIONS) do begin
   {$IFNDEF WEBP}if EXTENSIONS[i]='.webp' then continue;{$ENDIF}
   {$IFNDEF IOS}if EXTENSIONS[i]='.pvr' then continue;{$ENDIF}
   SetLength(names,length(names)+1);
   names[high(names)]:=fname+EXTENSIONS[i];
  end;
  i:=Files.SelectFile(names); // a layered provider may prefer its top layer
  if i>=0 then result:=names[i]
   else result:='';
  if (result='') and not dontFail then
   raise EWarning.Create(fname+' not found');
 end;

// Can an already loaded texture serve this request? Only frozen content is shared,
// thread-local textures never are, and the storage settings must match the ones the
// first loader chose (clamp mode, mip-maps)
function ShareableImage(tex:TTexture;flags:cardinal):boolean;
 var
  wantClamp,wantMips:boolean;
 begin
  if tex.HasFlag(tfThreadLocal) or not tex.HasFlag(tfImmutable) then exit(false);
  if Bits.HasAll(flags,liffAllowChange) then exit(false);
  wantClamp:=not Bits.HasAny(flags,liffTexture or liffPow2 or liffMipMaps);
  wantMips:=Bits.HasAll(flags,liffMipMaps);
  result:=(wantClamp=tex.HasFlag(tfClamped)) and (wantMips=tex.HasFlag(tfAutoMipMap));
 end;

// Load an image file. Normally (reuse=true) an already loaded texture is shared, atlases
// and the preload queue are used, and the new texture is registered as a file image.
// For a reload (reuse=false) the result is a private donor: always decoded from the
// file, not indexed, not registered; its source key is returned in fileKey.
function LoadFileImage(fname:String8;flags:cardinal;ForceFormat:TImagePixelFormat;
  reuse:boolean;out fileKey:String8):TTexture;
var
 i,j,k:integer;
 ref,key:String8;
 request:TImageLoadRequest;
 tex:TTexture;
 img,preloaded:TRawImage;
 aFlags:integer;
 data,rawData:ByteArray;
 format:TImageFileType;
 dp:PByte;
 time:int64;
 st:String8;
 allocated:boolean;
begin
 img:=nil; allocated:=false; tex:=nil; fileKey:='';
 request.ref:=fname; request.flags:=flags; request.format:=ForceFormat;
 try
  // 1. ADJUST FILE NAME, CHECK THE SOURCE REGISTRY AND ATLASES
  fname:=Files.FixName(fname);
  ref:=fname;
  // with extension: the texture loaded from this file; without: from any of its files
  if reuse then tex:=TTexture.FindByFile(ref);
  if (tex<>nil) and ShareableImage(tex,flags) then exit(tex.AddRef); // one more holder, released by FreeImage
  // Search atlases first
  if reuse then i:=FindFileInAtlas(fname)
   else i:=0;
  if i>0 then begin
   result:=aImages[i].Clone;
   exit;
  end;
  {$IFNDEF MSWINDOWS} // Use root dir
  //if (defaultImagesDir<>'') and (fname[1]<>'/') then fname:=defaultImagesDir+fname;
  {$ENDIF}
  if ExtractFileExt8(fname)='' then begin // find file
   fName:=FindProperFile(fName,Bits.HasAll(flags,liffNoFail));
   if fName='' then exit(nil);
  end;
  // The chosen file may already be loaded by its own name
  if reuse and (tex=nil) and (fname<>ref) then begin
   tex:=TTexture.FindByFile(fname);
   if (tex<>nil) and ShareableImage(tex,flags) then exit(tex.AddRef);
  end;
  if tex<>nil then
   Log.Warn('Image %s is already loaded with different settings - loading a private copy',[tex.src]);
  key:=TTexture.SourceKey(fname);

  time:=CoreTime.Ticks;
  Log.Msg('Loading '+fname);
  if reuse then preloaded:=GetImageFromQueue(fname)
   else preloaded:=nil;
  if preloaded<>nil then begin
   imgInfo.format:=preloaded.PixelFormat;
   imgInfo.width:=preloaded.width;
   imgInfo.height:=preloaded.height;
  end else begin
   // 2. LOAD DATA FILE AND CHECK IT'S FORMAT
   data:=Files.LoadAsBytes(fname);
   if length(data)<30 then raise EError.Create('Bad image file: '+fname);

   format:=CheckImageFormat(data);
   if not (format in [ifTGA,ifJPEG,ifPNG,ifWebP,ifDDS,ifPVR]) then
    raise EError.Create('image format not supported');

   // 2.5 FOR JPEG: LOAD SEPARATE ALPHA CHANNEL (IF EXISTS)
   if format=ifJPEG then begin
    st:=fname.Replace(ExtractFileExt8(fname),'.raw');
    Log.Force('Checking '+st);
    if Files.Exists(st) then begin
     Log.Force('Loading RAW alpha ');
     rawData:=Files.LoadAsBytes(st);
     if (length(rawData)>0) and (RLE.CheckHeader(@rawdata[0],length(rawData))>0) then
       rawData:=RLE.Unpack(@rawdata[0],length(rawData));
     forceFormat:=ipfARGB;
    end;
   end;
  end;

  // 3. ADJUST IMAGE FORMAT
  if ForceFormat=ipfNone then ForceFormat:=ImgInfo.format;
  if ForceFormat=ipf32bpp then
   if ImgInfo.format in [ipfXRGB,ipfRGB,ipf555,ipf565] then ForceFormat:=ipfXRGB
    else ForceFormat:=ipfARGB;
  AdjustFormat(ForceFormat);

  // 4. ALLOCATE TEXTURE AND LOCK ITS DATA
  if flags and liffSysMem>0 then aflags:=aiSysMem else aFlags:=0;
  if flags and liffTexture>0 then aflags:=aflags or aiTexture
    else aFlags:=aFlags or aiClampUV;
  if flags and liffPow2>0 then aflags:=aflags or aiTexture or aiPow2;
  if flags and liffMipMaps>0 then aflags:=aflags or aiTexture or aiAutoMipmap; // NPOT mip chains are baseline: no padding
  if imgInfo.miplevels>1 then flags:=flags or aiAutoMipmap;
  aFlags:=aFlags or (flags and $FF0000); // keep some flags
  // Non-unique label: file identity lives in the source registry (src), not in the
  // name registry, so a private copy of the same file never collides
  tex:=AllocImage(ImgInfo.width,ImgInfo.height,ForceFormat,aFlags,'_'+key) as TTexture;
  allocated:=true;
  fileKey:=key;
  if reuse then begin
   tex.src:=key;
   tex.SetLoadRequest(request);
  end;
  tex.Lock(0);
  img:=tex.GetRawImage; // get a RAW Image object to access texture data

  if preloaded<>nil then begin
   img.CopyPixelDataFrom(preloaded); // don't free preloaded as it is kept in the queue
   Log.Msg('Copied from preloaded: '+fname);
  end else begin
   // 5. LOAD SOURCE IMAGE FORMAT INTO TEXTURE MEMORY
   if format=ifTGA then LoadTGA(data,img) else
   if format=ifJPEG then LoadJPEG(data,img) else
   if format=ifPNG then LoadPNG(data,img) else
   if format=ifWebP then LoadWebP(data,img) else
   if format=ifPVR then LoadPVR(data,img) else
   if format=ifDDS then LoadDDS(data,img);

   // 6. ADD ALPHA CHANNEL FROM A SEPARATE RLE/RAW IMAGE IF EXISTS (JPEG-ONLY)
   if (length(rawData)>0) and (tex.PixelFormat=ipfARGB) then begin
    if length(rawData)<tex.width*tex.height then
     raise EError.Create('RAW alpha size mismatch for '+fname);
    Log.Force('Adding separate alpha');
    k:=0;
    for i:=0 to tex.height-1 do begin
     dp:=tex.data; inc(dp,i*tex.pitch+3);
     for j:=0 to tex.width-1 do begin
      // Legacy JPEG sidecars store 5-bit alpha (0..31), not 8-bit samples.
      dp^:=Min(255,round(8.22*rawData[k]));
      inc(dp,4);
      inc(k);
     end;
    end;
   end;
  end;

  // 7. FINISH TEXTURE
  tex.unlock;
  FreeAndNil(img);
  // Frozen content is the default: only immutable textures can be shared
  if not Bits.HasAll(flags,liffAllowChange) then tex.MakeImmutable;

 except
  on e:Exception do begin
   FreeAndNil(img);
   if allocated then begin // a half-loaded texture is released, not leaked
    if tex.IsLocked then tex.Unlock;
    FreeImage(tex);
   end;
   if Bits.HasAll(flags,liffNoFail) then exit(nil)
    else raise EWarning.Create(fname+' - Loading failed: '+ExceptionMsg(e));
  end;
 end;

 // 8. TIME CALCULATIONS
 time:=CoreTime.Ticks-time+random(2);
 if (time>0) and (time<50000) then inc(loadingTime,time);
 if time>30 then Log.Msg('Slow image loading: '+inttostr(time)+' - '+fname);
 result:=tex;
end;

function LoadImageFromFile(fname:String8;flags:cardinal=0;ForceFormat:TImagePixelFormat=ipfNone):TTexture;
var
 key:String8;
begin
 result:=LoadFileImage(fname,flags,ForceFormat,true,key);
end;

function ReloadFileImages(const prefix:String8=''):integer;
var
 all,images,donors:TTextures;
 keys:Strings8;
 request:TImageLoadRequest;
 key:String8;
 i,n:integer;
begin
 if multiWindowMode then raise EWarning.Create('File image reload requires a single render window');
 all:=TTexture.FileImages;
 // the images to reload
 key:=TTexture.SourceKey(prefix);
 SetLength(images,length(all)); n:=0;
 for i:=0 to high(all) do
  if (prefix='') or TTexture.SourceKey(all[i].loadRequest.ref).StartsWith(key,true) then begin
   images[n]:=all[i]; inc(n);
  end;
 SetLength(images,n);
 SetLength(donors,n); SetLength(keys,n);
 try
  // 1. PREPARE: decode every replacement and make it GPU-ready, nothing visible changes
  for i:=0 to n-1 do begin
   request:=images[i].loadRequest;
   donors[i]:=LoadFileImage(request.ref,request.flags and not liffNoFail,request.format,false,keys[i]);
   images[i].PrepareContentExchange(donors[i]);
  end;
  // 2. COMMIT: exchanges don't fail once prepared
  for i:=0 to n-1 do images[i].ExchangeContent(donors[i]);
  TTexture.ChangeSources(images,keys);
  result:=n;
 finally
  // donors hold the old storage now (or the unused replacements after a failure)
  for i:=0 to n-1 do FreeImage(donors[i]);
 end;
end;

function CreateSubImage(source:TTexture;x,y,width,height,flags:integer):TTexture;
var
 tex:TTexture;
 i,PixSize:integer;
 sp,dp:PByte;
begin
 ASSERT((x>=0) and (y>=0) and (x+width<=source.width) and (y+height<=source.height));
 tex:=AllocImage(width,height,source.PixelFormat,flags,'p_'+source.name) as TTexture;
 tex.Lock;
 source.Lock(0,lmReadOnly);
 sp:=source.data;
 dp:=tex.data;
 PixSize:=PixelSize[source.pixelFormat] div 8;
 inc(sp,source.pitch*y+x*PixSize);
 for i:=1 to height do begin
  move(sp^,dp^,width*PixSize);
  inc(sp,source.pitch);
  inc(dp,tex.pitch);
 end;
 source.Unlock;
 tex.unlock;
 result:=tex;
end;

function CreateImageCopy(source:TTexture):TTexture;
begin
 result:=CreateSubImage(source,0,0,source.width,source.height,aiMW1024+aiMH1024);
end;

procedure CopyImageRect(source,dest:TTexture;sx,sy,width,height,targetX,targetY:integer);
begin
 source.Lock(0,lmReadOnly);
 dest.Lock(0);
 try
  CopyRect(source.data,source.pitch,dest.data,dest.pitch,
   sx,sy,width,height,targetX,targetY);
 finally
  dest.Unlock;
  source.Unlock;
 end;
end;

function CreateImageFromString(st:string8;padding:integer;flags:cardinal):TTexture;
 var
  image:TRawImage;
 begin
  image:=nil;
  LoadSTR(st,image);
  image.Expand(padding,padding,padding,padding);
  result:=AllocImage(image.width,image.height,ipfARGB,flags,'STR');
  result.Upload(image.data,image.pitch,image.pixelFormat);
  image.Free;
 end;

procedure LoadImage(var img:TTexture;fName:String8;flags:cardinal=liffDefault);
 begin
   if flags=liffDefault then flags:=defaultLoadImageFlags;
   if img<>nil then FreeImage(TTexture(img));

   if Files.IsPathRelative(fName) and
     not fName.StartsWith('..') then fName:=defaultImagesDir+fName;
   img:=LoadImageFromFile(fName,flags,ipf32bpp);
 end;

procedure SaveImage(img:TTexture;fName:String8);
 var
   buf:ByteArray;
 begin
   fname:=Files.FixName(fname);
   img.Lock(0,lmReadOnly);
   try
    buf:=SaveTGA(img.GetRawImage);
    Files.Save(fname,buf);
   finally
    img.Unlock;
   end;
 end;

procedure EditImage(tex:TTexture);
 begin
  if not tex.IsLocked then tex.lock(0);
  SetRenderTarget(tex.data,tex.pitch,tex.width,tex.height);
 end;

function CropImage(image:TTexture;x1,y1,x2,y2:integer):TTexture;
 begin
  result:=image.ClonePart(Rect(x1,y1,x2+1,y2+1));
 end;

{procedure ScaleImage(image:TTexture;scaleX,scaleY:single);
 begin
  image.width:=round(image.width/scaleX);
  image.height:=round(image.height/scaleY);
  image.scaleX:=scaleX;
  image.scaleY:=scaleY;
  image.stepU:=image.stepU*scaleX;
  image.stepV:=image.stepV*scaleY;
  image.caps:=image.caps or tfScaled;
 end;}

 function ShrinkImage(image:TTexture;x1,x2,x3,x4,y1,y2,y3,y4:integer;overlap:integer):TTexture;
  var
   w,h,imgW,imgH:integer;
  begin
   w:=image.width-(x2-x1)-(x4-x3);
   h:=image.height-(y2-y1)-(y4-y3);
   result:=AllocImage(w,h,image.PixelFormat,0,image.name+'_shr') as TTexture;
   imgW:=image.width;
   imgH:=image.height;
   image.Lock(0,lmReadOnly);
   result.Lock;
   try
    // Top band
    CopyRect(image.data,image.pitch,result.data,result.pitch, 0,0, x1,     y1,   0,  0);
    CopyRect(image.data,image.pitch,result.data,result.pitch,x2,0, x3-x2,  y1,   x1, 0);
    CopyRect(image.data,image.pitch,result.data,result.pitch,x4,0, imgW-x4,y1,   x1+(x3-x2),0);
    // Middle band
    CopyRect(image.data,image.pitch,result.data,result.pitch, 0,y2, x1,     y3-y2,  0, y1);
    CopyRect(image.data,image.pitch,result.data,result.pitch,x2,y2, x3-x2,  y3-y2,  x1,y1);
    CopyRect(image.data,image.pitch,result.data,result.pitch,x4,y2, imgW-x4,y3-y2,  x1+(x3-x2),y1);
    // Bottom band
    CopyRect(image.data,image.pitch,result.data,result.pitch, 0,y4, x1,     imgH-y4,  0, y1+(y3-y2));
    CopyRect(image.data,image.pitch,result.data,result.pitch,x2,y4, x3-x2,  imgH-y4,  x1,y1+(y3-y2));
    CopyRect(image.data,image.pitch,result.data,result.pitch,x4,y4, imgW-x4,imgH-y4,  x1+(x3-x2),y1+(y3-y2));
   finally
    image.unlock;
    result.unlock;
   end;
  end;

 function ExpandImage(image:TTexture;x1,x2,y1,y2:integer;overlap:integer):TTexture;
  var
   w,h,dw,dh,i,j,sx,sy,dx,dy,bw,bh:integer;
  begin
   dw:=x2-x1;
   dh:=y2-y1;
   w:=image.width+dw;
   h:=image.height+dh;
   result:=AllocImage(w,h,image.PixelFormat,0,image.name+'_expd') as TTexture;
   image.Lock(0,lmReadOnly);
   result.Lock;
   try
    for i:=0 to 3 do
     for j:=0 to 3 do begin
      case j of
       0:begin sx:=0; dx:=0; bw:=x1+1; end;
       1,2:begin sx:=x1+1; dx:=sx+(j-1)*dw; bw:=dw; end;
       3:begin sx:=x2+1; dx:=sx+dw; bw:=image.width-x2; end;
      end;
      case i of
       0:begin sy:=0; dy:=0; bh:=y1+1; end;
       1,2:begin sy:=y1+1; dy:=sy+(i-1)*dh; bh:=dh; end;
       3:begin sy:=y2+1; dy:=sy+dh; bh:=image.height-y2; end;
      end;
      if (bw>0) and (bh>0) then
        CopyRect(image.data,image.pitch,result.data,result.pitch,
          sx,sy,bw,bh,dx,dy);
     end;
   finally
    image.unlock;
    result.unlock;
   end;
  end;

 function ResampleImage(image:TTexture;newWidth,newHeight:integer;sysMem:boolean=false):TTexture;
  var
   tmp:array of cardinal;
   w,h:integer;
   flipX,flipY:boolean;
   u1,v1,u2,v2:single;
  begin
   ASSERT(image.PixelFormat in [ipfARGB,ipfxRGB]);
   ASSERT((newWidth<>0) and (newHeight<>0));
   if (newWidth=image.width) and (newHeight=image.height) then begin
    result:=CreateImageCopy(image); exit;
   end;
   if newWidth<0 then begin
    flipX:=true; newWidth:=-newWidth;
   end else
    flipX:=false;
   if newHeight<0 then begin
    flipY:=true; newHeight:=-newHeight;
   end else
    flipY:=false;

   result:=AllocImage(newWidth,newHeight,ipfARGB,
       aiSysMem*byte(sysMem),'_'+image.name) as TTexture;
   result.Lock;
   if (newWidth>image.width) or (newHeight>image.height) then begin
    // When stretching images, artifacts are likely on the top and bottom lines,
    // so create a temporary image by extending the source with a 1px border
    w:=image.width+2; h:=image.height+2;
    SetLength(tmp,w*h);
//   Mem.Fill(tmp[0],w*h*4,0);
    image.Lock(0,lmReadOnly);
    CopyRect(image.data,image.pitch,@tmp[0],w*4,0,0,w-2,h-2,1,1); // main part
    image.Unlock;
    CopyRect(@tmp[0],w*4,@tmp[0],w*4, 1,1,   w-2,1,  1,0); // top line
    CopyRect(@tmp[0],w*4,@tmp[0],w*4, 1,h-2, w-2,1,  1,h-1); // bottom line
    CopyRect(@tmp[0],w*4,@tmp[0],w*4, 1,0,   1,h,    0,0); // left line
    CopyRect(@tmp[0],w*4,@tmp[0],w*4, w-2,0, 1,h,    w-1,0); // right line

    FillRect(result.data,result.pitch,0,0,newWidth-1,newHeight-1,$0);
    StretchDraw(@tmp[w+1],w*4,result.data,result.pitch,
      0,0,newWidth-1,newHeight-1,
      0,0,w-2,h-2,blCopy);
   end else begin
    // Downscaling is much simpler
    image.Lock(0,lmReadOnly);
    u1:=0; u2:=image.width;
    v1:=0; v2:=image.height;
    if flipX then Swap(u1,u2);
    if flipY then Swap(v1,v2);
    StretchDraw(image.data,image.pitch,result.data,result.pitch,
      0,0,newWidth-1,newHeight-1,
      u1,v1,u2,v2,blCopy);
    image.Unlock;
   end;
   result.Unlock;
  end;

 procedure SharpenImage(image:TTexture;strength:integer);
  begin
   ASSERT(image.PixelFormat in [ipfARGB,ipfxRGB]);
   image.lock;
   try
    Sharpen(image.data,image.pitch,image.width,image.height,strength);
   finally
    image.unlock;
   end;
  end;

 procedure AdjustImage(image:TTexture;brightness,contrast,saturation:single);
  var
   mat:TMat34;
  begin
   ASSERT(image.PixelFormat in [ipfARGB,ipfxRGB]);
   image.lock;
   try
    mat:=Apus.GfxFilters.Saturation(saturation) * BrightnessContrast(brightness,contrast);
    //MultMat(,mat);
    MixRGB(image.data,image.pitch,image.width,image.height,mat);
   finally
    image.unlock;
   end;
  end;

 procedure ImageHueSaturation(image:TTexture;hue,saturation:single);
  var
   mat:TMat34;
  begin
   ASSERT(image.PixelFormat in [ipfARGB,ipfxRGB]);
   image.lock;
   try
    mat:=Apus.GfxFilters.Saturation(saturation) * Apus.GfxFilters.Hue(hue);
    //MultMat(Apus.GfxFilters.Saturation(saturation),Apus.GfxFilters.Hue(hue),mat);
    MixRGB(image.data,image.pitch,image.width,image.height,mat);
   finally
    image.unlock;
   end;
  end;


initialization
 jpegImageHash.Init(false);
end.