libTextSuite/src/ultsImage.pas

unit ultsImage;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  utsTextSuite,
  ultsTypes;

type
  TltsImageLoadFunc  = procedure(aHandle: TltsImageHandle; X, Y: Integer; var aPixel: TtsColor4f; aArgs: Pointer);                                      stdcall;
  TltsImageBlendFunc = procedure(aHandle: TltsImageHandle; aSrc, aDst: TtsColor4f; out aResult: TtsColor4f; aArgs: Pointer);                            stdcall;

function ltsImageCreate       (aContext: TltsContextHandle):                                                                          TltsImageHandle;  stdcall;
function ltsImageIsEmpty      (aHandle: TltsImageHandle; out aValue: Boolean):                                                        TltsErrorCode;    stdcall;
function ltsImageGetWidth     (aHandle: TltsImageHandle):                                                                             Integer;          stdcall;
function ltsImageGetHeight    (aHandle: TltsImageHandle):                                                                             Integer;          stdcall;
function ltsImageGetLineSize  (aHandle: TltsImageHandle):                                                                             Integer;          stdcall;
function ltsImageGetDataSize  (aHandle: TltsImageHandle):                                                                             Integer;          stdcall;
function ltsImageGetFormat    (aHandle: TltsImageHandle; out aValue: TtsFormat):                                                      TltsErrorCode;    stdcall;
function ltsImageGetData      (aHandle: TltsImageHandle):                                                                             Pointer;          stdcall;
function ltsImageGetScanline  (aHandle: TltsImageHandle; aIndex: Integer):                                                            Pointer;          stdcall;
function ltsImageGetPixelAt   (aHandle: TltsImageHandle; aX, aY: Integer; out aColor: TtsColor4f):                                    TltsErrorCode;    stdcall;
function ltsImageAssign       (aHandle, aSource: TltsImageHandle):                                                                    TltsErrorCode;    stdcall;
function ltsImageCreateEmpty  (aHandle: TltsImageHandle; aFormat: TtsFormat; aWidth, aHeight: Integer):                               TltsErrorCode;    stdcall;
function ltsImageLoadFromFunc (aHandle: TltsImageHandle; aCallback: TltsImageLoadFunc; aArgs: Pointer):                               TltsErrorCode;    stdcall;
function ltsImageResize       (aHandle: TltsImageHandle; aWidth, aHeight, aX, aY: Integer):                                           TltsErrorCode;    stdcall;
function ltsImageFillColor    (aHandle: TltsImageHandle; aColor: TtsColor4f; aMask: TtsColorChannels; aModes: TtsImageModes):         TltsErrorCode;    stdcall;
function ltsImageFillPattern  (aHandle, aPattern: TltsImageHandle; aX, aY: Integer; aMask: TtsColorChannels; aModes: TtsImageModes):  TltsErrorCode;    stdcall;
function ltsImageBlend        (aHandle, aSource: TltsImageHandle; aX, aY: Integer; aBlendFunc: TltsImageBlendFunc; aArgs: Pointer):   TltsErrorCode;    stdcall;
function ltsImageBlur         (aHandle: TltsImageHandle; aHorzRad, aHorzStr, aVertRad, aVertStr: Single; aMask: TtsColorChannels):    TltsErrorCode;    stdcall;
function ltsImageDestroy      (aHandle: TltsImageHandle):                                                                             TltsErrorCode;    stdcall;

implementation

uses
  ultsUtils, utsUtils {$IFDEF DEBUG}, uutlLogger{$ENDIF};

type
  PLoadArgs = ^TLoadArgs;
  TLoadArgs = packed record
    args: Pointer;
    handle: TltsImageHandle;
    callback: TltsImageLoadFunc
  end;

  PBlendArgs = ^TBlendArgs;
  TBlendArgs = packed record
    args: Pointer;
    handle: TltsImageHandle;
    callback: TltsImageBlendFunc;
  end;

procedure ImageLoadCallback(const aImage: TtsImage; X, Y: Integer; var aPixel: TtsColor4f; aArgs: Pointer);
var
  p: PLoadArgs;
begin
  p := PLoadArgs(aArgs);
  p^.callback(p^.handle, X, Y, aPixel, p^.args);
end;

function ImageBlendCallback(const aSrc, aDst: TtsColor4f; aArgs: Pointer): TtsColor4f;
var
  p: PBlendArgs;
begin
  p := PBlendArgs(aArgs);
  p^.callback(p^.handle, aSrc, aDst, result, p^.args);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//ltsImage//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageCreate(aContext: TltsContextHandle): TltsImageHandle; stdcall;
var
  img: TtsImage;
  c: TtsContext;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageCreate(Context=%p)', [Pointer(aContext)]);{$ENDIF}
    result := nil;
    if not CheckContextHandle(aContext, c) then
      exit;
    img := TtsImage.Create(c);
    AddReference(ltsObjTypeImage, img);
    result := img;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;   
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageCreate=%p', [Pointer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageIsEmpty(aHandle: TltsImageHandle; out aValue: Boolean): TltsErrorCode; stdcall;
var
  img: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageIsEmpty(Handle=%p; Value=%p)', [Pointer(aHandle), Pointer(@aValue)]);{$ENDIF}
    result := ltsErrNone;
    if CheckImageHandle(aHandle, img)
      then aValue := img.IsEmpty
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;  
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageIsEmpty=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetWidth(aHandle: TltsImageHandle): Integer; stdcall;
var
  img: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetWidth(Handle=%p)', [Pointer(aHandle)]);{$ENDIF}
    if CheckImageHandle(aHandle, img)
      then result := img.Width
      else result := -1;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := -1;
    end;
  end;  
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetWidth=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetHeight(aHandle: TltsImageHandle): Integer; stdcall;
var
  img: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetHeight(Handle=%p)', [Pointer(aHandle)]);{$ENDIF}
    if CheckImageHandle(aHandle, img)
      then result := img.Height
      else result := -1;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := -1;
    end;
  end;  
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetHeight=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetLineSize(aHandle: TltsImageHandle): Integer; stdcall;
var
  img: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetLineSize(Handle=%p)', [Pointer(aHandle)]);{$ENDIF}
    if CheckImageHandle(aHandle, img)
      then result := img.LineSize
      else result := -1;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := -1;
    end;
  end;   
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetLineSize=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetDataSize(aHandle: TltsImageHandle): Integer; stdcall;
var
  img: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetDataSize(Handle=%p)', [Pointer(aHandle)]);{$ENDIF}
    if CheckImageHandle(aHandle, img)
      then result := img.DataSize
      else result := -1;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := -1;
    end;
  end;    
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetDataSize=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetFormat(aHandle: TltsImageHandle; out aValue: TtsFormat): TltsErrorCode; stdcall;
var
  img: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetFormat(Handle=%p; Value=%p)', [Pointer(aHandle), Pointer(@aValue)]);{$ENDIF}
    result := ltsErrNone;
    if CheckImageHandle(aHandle, img)
      then aValue := img.Format
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;    
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetFormat=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetData(aHandle: TltsImageHandle): Pointer; stdcall;
var
  img: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetData(Handle=%p)', [Pointer(aHandle)]);{$ENDIF}
    if CheckImageHandle(aHandle, img)
      then result := img.Data
      else result := nil;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;     
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetData=%p', [Pointer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetScanline(aHandle: TltsImageHandle; aIndex: Integer): Pointer; stdcall;
var
  img: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetScanline(Handle=%p; Index=%d)', [Pointer(aHandle), aIndex]);{$ENDIF}
    if CheckImageHandle(aHandle, img) then begin
      result := img.Scanline[aIndex];
      if not Assigned(result) then
        SetLastError(ltsErrInvalidValue, Format('index (%d) is out of range', [aIndex]));
    end else
      result := nil;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;    
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetScanline=%p', [Pointer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetPixelAt(aHandle: TltsImageHandle; aX, aY: Integer; out aColor: TtsColor4f): TltsErrorCode; stdcall;
var
  img: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetPixelAt(Handle=%p; X=%d; Y=%d; Color=%p)', [Pointer(aHandle), aX, aY, Pointer(@aColor)]);{$ENDIF}
    result := ltsErrNone;
    if CheckImageHandle(aHandle, img) then begin
      if not img.GetPixelAt(aX, aY, aColor) then begin
        SetLastError(ltsErrInvalidValue, Format('x (%d) or y (%d) is out of range', [aX, aY]));
        result := LastErrorCode;
      end;
    end else
      result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;  
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetPixelAt=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageAssign(aHandle, aSource: TltsImageHandle): TltsErrorCode; stdcall;
var
  img, src: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageAssign(Handle=%p; Source=%p)', [Pointer(aHandle), Pointer(aSource)]);{$ENDIF}
    result := ltsErrNone;
    if CheckImageHandle(aHandle, img) and CheckImageHandle(aSource, src)
      then img.Assign(src)
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;  
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageAssign=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageCreateEmpty(aHandle: TltsImageHandle; aFormat: TtsFormat; aWidth, aHeight: Integer): TltsErrorCode; stdcall;
var
  img: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageCreateEmpty(Handle=%p; Format=%d; Width=%d; Height=%d)', [Pointer(aHandle), Integer(aFormat), aWidth, aHeight]);{$ENDIF}
    result := ltsErrNone;
    if not ValidateFormat(aFormat) then begin
      result := LastErrorCode;
    end else if (aWidth < 0) then begin
      SetLastError(ltsErrInvalidValue, 'width must be a positive value');
      result := LastErrorCode;
    end else if (aHeight < 0) then begin
      SetLastError(ltsErrInvalidValue, 'height must be a positive value');
      result := LastErrorCode;
    end else if not CheckImageHandle(aHandle, img) then begin
      result := LastErrorCode;
    end else
      img.CreateEmpty(aFormat, aWidth, aHeight);
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;   
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageCreateEmpty=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageLoadFromFunc(aHandle: TltsImageHandle; aCallback: TltsImageLoadFunc; aArgs: Pointer): TltsErrorCode; stdcall;
var
  img: TtsImage;
  la: TLoadArgs;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageLoadFromFunc(Handle=%p; Callback=%p; Args=%p)', [Pointer(aHandle), Pointer(aCallback), aArgs]);{$ENDIF}
    result := ltsErrNone;
    if CheckImageHandle(aHandle, img) then begin
      la.args     := aArgs;
      la.callback := aCallback;
      la.handle   := aHandle;
      img.LoadFromFunc(@ImageLoadCallback, @la);
    end else
      result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;  
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageLoadFromFunc=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageResize(aHandle: TltsImageHandle; aWidth, aHeight, aX, aY: Integer): TltsErrorCode; stdcall;
var
  img: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageResize(Handle=%p; Width=%d; Height=%d; X=%d; Y=%d)', [Pointer(aHandle), aWidth, aHeight, aX, aY]);{$ENDIF}
    result := ltsErrNone;
    if (aWidth < 0) then begin
      SetLastError(ltsErrInvalidValue, 'width must be a positive value');
      result := LastErrorCode;
    end else if (aHeight < 0) then begin
      SetLastError(ltsErrInvalidValue, 'height must be a positive value');
      result := LastErrorCode;
    end else if not CheckImageHandle(aHandle, img) then begin
      result := LastErrorCode;
    end else
      img.Resize(aWidth, aHeight, aX, aY);
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;   
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageResize=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageFillColor(aHandle: TltsImageHandle; aColor: TtsColor4f; aMask: TtsColorChannels; aModes: TtsImageModes): TltsErrorCode; stdcall;
var
  img: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageFillColor(Handle=%p; Color=(%f;%f;%f;%f); Mask=%d; Modes=(%d;%d;%d;%d))', [Pointer(aHandle), aColor.r, aColor.g, aColor.b, aColor.a, Integer(aMask), Integer(aModes[TtsColorChannel.tsChannelRed]), Integer(aModes[TtsColorChannel.tsChannelGreen]), Integer(aModes[TtsColorChannel.tsChannelBlue]), Integer(aModes[TtsColorChannel.tsChannelAlpha])]);{$ENDIF}
    result := ltsErrNone;
    if CheckImageHandle(aHandle, img)
      then img.FillColor(aColor, aMask, aModes)
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;  
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageFillColor=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageFillPattern(aHandle, aPattern: TltsImageHandle; aX, aY: Integer; aMask: TtsColorChannels; aModes: TtsImageModes): TltsErrorCode; stdcall;
var
  img, pattern: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageFillPattern(Handle=%p; Pattern=%p; X=%d; Y=%d; Mask=%d; Modes=(%d;%d;%d;%d))', [Pointer(aHandle), Pointer(aPattern), aX, aY, Integer(aMask), Integer(aModes[TtsColorChannel.tsChannelRed]), Integer(aModes[TtsColorChannel.tsChannelGreen]), Integer(aModes[TtsColorChannel.tsChannelBlue]), Integer(aModes[TtsColorChannel.tsChannelAlpha])]);{$ENDIF}
    result := ltsErrNone;
    if CheckImageHandle(aHandle, img) and CheckImageHandle(aPattern, pattern)
      then img.FillPattern(pattern, aX, aY, aMask, aModes)
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end; 
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageFillPattern=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageBlend(aHandle, aSource: TltsImageHandle; aX, aY: Integer; aBlendFunc: TltsImageBlendFunc; aArgs: Pointer): TltsErrorCode; stdcall;
var
  img, src: TtsImage;
  ba: TBlendArgs;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageBlend(Handle=%p; Source=%p; X=%d; Y=%d; BlendFunc=%p; Args=%p)', [Pointer(aHandle), Pointer(aSource), aX, aY, Pointer(aBlendFunc), aArgs]);{$ENDIF}
    result := ltsErrNone;
    if CheckImageHandle(aHandle, img) and CheckImageHandle(aSource, src) then begin
      ba.args     := aArgs;
      ba.handle   := aHandle;
      ba.callback := aBlendFunc;
      img.Blend(src, aX, aY, @ImageBlendCallback, @ba);
    end else
      result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageBlend=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageBlur(aHandle: TltsImageHandle; aHorzRad, aHorzStr, aVertRad, aVertStr: Single; aMask: TtsColorChannels): TltsErrorCode; stdcall;
var
  img: TtsImage;
  horz, vert: TtsKernel1D;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageBlur(Handle=%p; HorzRad=%f; HorzStr=%f; VertRad=%f; VertStr=%f; Mask=%d)', [Pointer(aHandle), aHorzRad, aHorzStr, aVertRad, aVertStr, Integer(aMask)]);{$ENDIF}
    result := ltsErrNone;
    if CheckImageHandle(aHandle, img) then begin
      horz := TtsKernel1D.Create(aHorzRad, aHorzStr);
      vert := TtsKernel1D.Create(aVertRad, aVertStr);
      try
        img.Blur(horz, vert, aMask);
      finally
        FreeAndNil(horz);
        FreeAndNil(vert);
      end;
    end else
      result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageBlur=%d', [Integer(result)]);{$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageDestroy(aHandle: TltsImageHandle): TltsErrorCode; stdcall;
var
  img: TtsImage;
begin
  try
    {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageDestroy(Handle=%p)', [Pointer(aHandle)]);{$ENDIF}
    result := ltsErrNone;
    if CheckImageHandle(aHandle, img) then begin
      DelReference(ltsObjTypeImage, img);
      FreeAndNil(img);
    end else
      result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
  {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageDestroy=%d', [Integer(result)]);{$ENDIF}
end;

end.