libTextSuite/ultsImage.pas

unit ultsImage;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  utsTextSuite,
  ultsTypes;

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

function ltsImageCreate       (const aContext: TltsContextHandle):                                                                                            TltsImageHandle;  stdcall;
function ltsImageIsEmpty      (const aHandle: TltsImageHandle; var aValue: Boolean):                                                                          TltsErrorCode;    stdcall;
function ltsImageGetWidth     (const aHandle: TltsImageHandle):                                                                                               Integer;          stdcall;
function ltsImageGetHeight    (const aHandle: TltsImageHandle):                                                                                               Integer;          stdcall;
function ltsImageGetLineSize  (const aHandle: TltsImageHandle):                                                                                               Integer;          stdcall;
function ltsImageGetDataSize  (const aHandle: TltsImageHandle):                                                                                               Integer;          stdcall;
function ltsImageGetFormat    (const aHandle: TltsImageHandle; var aValue: TtsFormat):                                                                        TltsErrorCode;    stdcall;
function ltsImageGetData      (const aHandle: TltsImageHandle):                                                                                               Pointer;          stdcall;
function ltsImageGetScanline  (const aHandle: TltsImageHandle; const aIndex: Integer):                                                                        Pointer;          stdcall;
function ltsImageGetPixelAt   (const aHandle: TltsImageHandle; const aX, aY: Integer; var aColor: TtsColor4f):                                                TltsErrorCode;    stdcall;
function ltsImageAssign       (const aHandle, aSource: TltsImageHandle):                                                                                      TltsErrorCode;    stdcall;
function ltsImageCreateEmpty  (const aHandle: TltsImageHandle; const aFormat: TtsFormat; const aWidth, aHeight: Integer):                                     TltsErrorCode;    stdcall;
function ltsImageLoadFromFunc (const aHandle: TltsImageHandle; const aCallback: TltsImageLoadFunc; aArgs: Pointer):                                               TltsErrorCode;    stdcall;
function ltsImageResize       (const aHandle: TltsImageHandle; const aWidth, aHeight, aX, aY: Integer):                                                       TltsErrorCode;    stdcall;
function ltsImageFillColor    (const aHandle: TltsImageHandle; const aColor: TtsColor4f; const aMask: TtsColorChannels; const aModes: TtsImageModes):         TltsErrorCode;    stdcall;
function ltsImageFillPattern  (const aHandle, aPattern: TltsImageHandle; const aX, aY: Integer; const aMask: TtsColorChannels; const aModes: TtsImageModes):  TltsErrorCode;    stdcall;
function ltsImageBlend        (const aHandle, aSource: TltsImageHandle; const aX, aY: Integer; const aBlendFunc: TltsImageBlendFunc; aArgs: Pointer):         TltsErrorCode;    stdcall;
function ltsImageBlur         (const aHandle: TltsImageHandle; const aHorzRad, aHorzStr, aVertRad, aVertStr: Single; const aMask: TtsColorChannels):          TltsErrorCode;    stdcall;
function ltsImageDestroy      (const 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);
  result := p^.callback(p^.handle, aSrc, aDst, p^.args);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//ltsImage//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageCreate(const 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(const aHandle: TltsImageHandle; var 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(const 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(const 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(const 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(const 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(const aHandle: TltsImageHandle; var 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(const 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(const aHandle: TltsImageHandle; const 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(const aHandle: TltsImageHandle; const aX, aY: Integer; var 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(const 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(const aHandle: TltsImageHandle; const aFormat: TtsFormat; const 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(const aHandle: TltsImageHandle; const 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(const aHandle: TltsImageHandle; const 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(const aHandle: TltsImageHandle; const aColor: TtsColor4f; const aMask: TtsColorChannels; const 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(const aHandle, aPattern: TltsImageHandle; const aX, aY: Integer; const aMask: TtsColorChannels; const 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(const aHandle, aSource: TltsImageHandle; const aX, aY: Integer; const 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(const aHandle: TltsImageHandle; const aHorzRad, aHorzStr, aVertRad, aVertStr: Single; const 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(const 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.