libTextSuite/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;

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
    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;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageIsEmpty(aHandle: TltsImageHandle; out aValue: Boolean): TltsErrorCode; stdcall;
var
  img: TtsImage;
begin
  try
    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;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetWidth(aHandle: TltsImageHandle): Integer; stdcall;
var
  img: TtsImage;
begin
  try
    if CheckImageHandle(aHandle, img)
      then result := img.Width
      else result := -1;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := -1;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetHeight(aHandle: TltsImageHandle): Integer; stdcall;
var
  img: TtsImage;
begin
  try
    if CheckImageHandle(aHandle, img)
      then result := img.Height
      else result := -1;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := -1;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetLineSize(aHandle: TltsImageHandle): Integer; stdcall;
var
  img: TtsImage;
begin
  try
    if CheckImageHandle(aHandle, img)
      then result := img.LineSize
      else result := -1;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := -1;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetDataSize(aHandle: TltsImageHandle): Integer; stdcall;
var
  img: TtsImage;
begin
  try
    if CheckImageHandle(aHandle, img)
      then result := img.DataSize
      else result := -1;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := -1;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetFormat(aHandle: TltsImageHandle; out aValue: TtsFormat): TltsErrorCode; stdcall;
var
  img: TtsImage;
begin
  try
    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;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetData(aHandle: TltsImageHandle): Pointer; stdcall;
var
  img: TtsImage;
begin
  try
    if CheckImageHandle(aHandle, img)
      then result := img.Data
      else result := nil;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetScanline(aHandle: TltsImageHandle; aIndex: Integer): Pointer; stdcall;
var
  img: TtsImage;
begin
  try
    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;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageGetPixelAt(aHandle: TltsImageHandle; aX, aY: Integer; out aColor: TtsColor4f): TltsErrorCode; stdcall;
var
  img: TtsImage;
begin
  try
    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;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageAssign(aHandle, aSource: TltsImageHandle): TltsErrorCode; stdcall;
var
  img, src: TtsImage;
begin
  try
    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;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageCreateEmpty(aHandle: TltsImageHandle; aFormat: TtsFormat; aWidth, aHeight: Integer): TltsErrorCode; stdcall;
var
  img: TtsImage;
begin
  try
    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;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageLoadFromFunc(aHandle: TltsImageHandle; aCallback: TltsImageLoadFunc; aArgs: Pointer): TltsErrorCode; stdcall;
var
  img: TtsImage;
  la: TLoadArgs;
begin
  try
    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;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageResize(aHandle: TltsImageHandle; aWidth, aHeight, aX, aY: Integer): TltsErrorCode; stdcall;
var
  img: TtsImage;
begin
  try
    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;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageFillColor(aHandle: TltsImageHandle; aColor: TtsColor4f; aMask: TtsColorChannels; aModes: TtsImageModes): TltsErrorCode; stdcall;
var
  img: TtsImage;
begin
  try
    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;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageFillPattern(aHandle, aPattern: TltsImageHandle; aX, aY: Integer; aMask: TtsColorChannels; aModes: TtsImageModes): TltsErrorCode; stdcall;
var
  img, pattern: TtsImage;
begin
  try
    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;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageBlend(aHandle, aSource: TltsImageHandle; aX, aY: Integer; aBlendFunc: TltsImageBlendFunc; aArgs: Pointer): TltsErrorCode; stdcall;
var
  img, src: TtsImage;
  ba: TBlendArgs;
begin
  try
    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;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageBlur(aHandle: TltsImageHandle; aHorzRad, aHorzStr, aVertRad, aVertStr: Single; aMask: TtsColorChannels): TltsErrorCode; stdcall;
var
  img: TtsImage;
  horz, vert: TtsKernel1D;
begin
  try
    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;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageDestroy(aHandle: TltsImageHandle): TltsErrorCode; stdcall;
var
  img: TtsImage;
begin
  try
    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;
end;

end.