libTextSuite/ultsPostProcessor.pas

unit ultsPostProcessor;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  ultsTypes, utsTextSuite;

type
  TltsPostProcessorExecuteFunc = procedure(const aCharHandle: TltsCharHandle; const aImageHandle: TltsImageHandle; aArgs: Pointer); stdcall;

  PltsPostProcessorCustomData = ^TltsPostProcessorCustomData;
  TltsPostProcessorCustomData = packed record
    args: Pointer;
    execute: TltsPostProcessorExecuteFunc;
  end;

  TltsPostProcessorCustom = class(TtsPostProcessor)
  private
    fData: TltsPostProcessorCustomData;
  public
    function Execute(const aChar: TtsChar; const aImage: TtsImage): Boolean; override;
    constructor Create(const aContext: TtsContext; const aData: TltsPostProcessorCustomData);
  end;

function ltsPostProcessorAddRange           (aHandle: TltsPostProcessorHandle; aUsage: TtsCharRangeUsage; aStart, aStop: WideChar): TltsErrorCode;            stdcall;
function ltsPostProcessorAddChars           (aHandle: TltsPostProcessorHandle; aUsage: TtsCharRangeUsage; aChars: PWideChar):       TltsErrorCode;            stdcall;
function ltsPostProcessorClearRanges        (aHandle: TltsPostProcessorHandle):                                                     TltsErrorCode;            stdcall;
function ltsPostProcessorExecute            (aHandle: TltsPostProcessorHandle; aChar: TltsCharHandle; aImage: TltsImageHandle):     TltsErrorCode;            stdcall;

function ltsPostProcessorFillColorCreate    (aContext: TltsContextHandle; aColor: TtsColor4f;
                                             aModes: TtsImageModes; aChannels: TtsColorChannels):                                   TltsPostProcessorHandle;  stdcall;
function ltsPostProcessorFillPatterCreate   (aContext: TltsContextHandle; aPattern: TltsImageHandle; aOwnsPatter: Boolean;
                                             aPosition: TtsPosition; aModes: TtsImageModes; aChannels: TtsColorChannels):           TltsPostProcessorHandle;  stdcall;
function ltsPostProcessorBorderCreate       (aContext: TltsContextHandle; aWidth, aStrength: Single;
                                             aColor: TtsColor4f; aKeepSize: Boolean):                                               TltsPostProcessorHandle;  stdcall;
function ltsPostProcessorShadowCreate       (aContext: TltsContextHandle; aRadius, aStrength: Single;
                                             aOffset: TtsPosition; aColor: TtsColor4f):                                             TltsPostProcessorHandle;  stdcall;
function ltsPostProcessorCustomCreate       (aContext: TltsContextHandle; constref aData: TltsPostProcessorCustomData):             TltsPostProcessorHandle;  stdcall;
function ltsPostProcessorDestroy            (aHandle: TltsPostProcessorHandle):                                                     TltsErrorCode;            stdcall;

implementation

uses
  ultsUtils;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//ltsPostProcessor//////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorAddRange(aHandle: TltsPostProcessorHandle; aUsage: TtsCharRangeUsage; aStart, aStop: WideChar): TltsErrorCode; stdcall;
var
  pp: TtsPostProcessor;
begin
  try
    result := ltsErrNone;
    if ValidateCharRangeUsage(aUsage) and CheckPostProcessorHandle(aHandle, TtsPostProcessor, pp)
      then pp.AddRange(aUsage, aStart, aStop)
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorAddChars(aHandle: TltsPostProcessorHandle; aUsage: TtsCharRangeUsage; aChars: PWideChar): TltsErrorCode; stdcall;
var
  pp: TtsPostProcessor;
begin
  try
    result := ltsErrNone;
    if ValidateCharRangeUsage(aUsage) and CheckPostProcessorHandle(aHandle, TtsPostProcessor, pp)
      then pp.AddChars(aUsage, aChars)
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorClearRanges(aHandle: TltsPostProcessorHandle): TltsErrorCode; stdcall;
var
  pp: TtsPostProcessor;
begin
  try
    result := ltsErrNone;
    if CheckPostProcessorHandle(aHandle, TtsPostProcessor, pp)
      then pp.ClearRanges
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorExecute(aHandle: TltsPostProcessorHandle; aChar: TltsCharHandle; aImage: TltsImageHandle): TltsErrorCode; stdcall;
var
  pp: TtsPostProcessor;
  c: TtsChar;
  i: TtsImage;
begin
  try
    result := ltsErrNone;
    if CheckPostProcessorHandle(aHandle, TtsPostProcessor, pp) and
       CheckCharHandle(aChar, c) and
       CheckImageHandle(aImage, i)
          then pp.Execute(c, i)
          else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorFillColorCreate(aContext: TltsContextHandle; aColor: TtsColor4f; aModes: TtsImageModes; aChannels: TtsColorChannels): TltsPostProcessorHandle; stdcall;
var
  c: TtsContext;
  pp: TtsPostProcessor;
begin
  try
    result := nil;
    if CheckContextHandle(aContext, c) then begin
      pp := TtsPostProcessorFillColor.Create(c, aColor, aModes, aChannels);
      AddReference(ltsObjTypePostProcessor, pp);
      result := pp;
    end;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorFillPatterCreate(aContext: TltsContextHandle; aPattern: TltsImageHandle; aOwnsPatter: Boolean; aPosition: TtsPosition; aModes: TtsImageModes; aChannels: TtsColorChannels): TltsPostProcessorHandle; stdcall;
var
  c: TtsContext;
  img: TtsImage;
  pp: TtsPostProcessor;
begin
  try
    result := nil;
    img    := nil;
    if CheckContextHandle(aContext, c) and CheckImageHandle(aPattern, img) then begin
      pp := TtsPostProcessorFillPattern.Create(c, img, aOwnsPatter, aPosition, aModes, aChannels);
      AddReference(ltsObjTypePostProcessor, pp);
      result := pp;
    end;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorBorderCreate(aContext: TltsContextHandle; aWidth, aStrength: Single; aColor: TtsColor4f; aKeepSize: Boolean): TltsPostProcessorHandle; stdcall;
var
  c: TtsContext;
  pp: TtsPostProcessor;
begin
  try
    result := nil;
    if CheckContextHandle(aContext, c) then begin
      pp := TtsPostProcessorBorder.Create(c, aWidth, aStrength, aColor, aKeepSize);
      AddReference(ltsObjTypePostProcessor, pp);
      result := pp;
    end;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorShadowCreate(aContext: TltsContextHandle; aRadius, aStrength: Single; aOffset: TtsPosition; aColor: TtsColor4f): TltsPostProcessorHandle; stdcall;
var
  c: TtsContext;
  pp: TtsPostProcessor;
begin
  try
    result := nil;
    if CheckContextHandle(aContext, c) then begin
      pp := TtsPostProcessorShadow.Create(c, aRadius, aStrength, aOffset, aColor);
      AddReference(ltsObjTypePostProcessor, pp);
      result := pp;
    end;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorCustomCreate(aContext: TltsContextHandle; constref aData: TltsPostProcessorCustomData): TltsPostProcessorHandle; stdcall;
var
  c: TtsContext;
  pp: TtsPostProcessor;
begin
  try
    result := nil;
    if CheckContextHandle(aContext, c) then begin
      pp := TltsPostProcessorCustom.Create(c, aData);
      AddReference(ltsObjTypePostProcessor, pp);
      result := pp;
    end;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorDestroy(aHandle: TltsPostProcessorHandle): TltsErrorCode; stdcall;
var
  pp: TtsPostProcessor;
begin
  try
    result := ltsErrNone;
    if CheckPostProcessorHandle(aHandle, TtsPostProcessor, pp) then begin
      if (pp is TtsPostProcessorFillPattern) then with (pp as TtsPostProcessorFillPattern) do begin
        if OwnsPattern then
          DelReference(ltsObjTypeImage, Pattern);
      end;
      DelReference(ltsObjTypePostProcessor, pp);
      FreeAndNil(pp);
    end else
      result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TltsPostProcessorCustom///////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TltsPostProcessorCustom.Execute(const aChar: TtsChar; const aImage: TtsImage): Boolean;
begin
  result := inherited Execute(aChar, aImage);
  if result then begin
    AddReference(ltsObjTypeChar, aChar);
    AddReference(ltsObjTypeImage, aImage);
    try
      fData.execute(aChar, aImage, fData.args);
    finally
      DelReference(ltsObjTypeChar, aChar);
      DelReference(ltsObjTypeImage, aImage);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TltsPostProcessorCustom.Create(const aContext: TtsContext; const aData: TltsPostProcessorCustomData);
begin
  inherited Create(aContext);
  fData := aData;
end;

end.