libTextSuite/ultsUtils.pas

unit ultsUtils;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  uutlGenerics,
  ultsTypes,
  utsTextSuite;

type
  TtsPostProcessorClass = class of TtsPostProcessor;

procedure SetLastError(const aEx: Exception);
procedure SetLastError(const aErrorCode: TltsErrorCode; const aErrorMsg: String);

function CheckIfInitialized: Boolean;
function CheckContextHandle(const aHandle: TltsContextHandle; out aContext: TtsContext): Boolean;
function CheckRendererHandle(const aHandle: TltsContextHandle; out aRenderer: TtsRenderer): Boolean;
function CheckTextBlockHandle(const aHandle: TltsTextBlockHandle; out aTextBlock: TtsTextBlock): Boolean;
function CheckFontHandle(const aHandle: TltsFontHandle; out aFont: TtsFont): Boolean;
function CheckFontCreatorHandle(const aHandle: TltsFontCreatorHandle; out aFontCreator: TtsFontCreator): Boolean;
function CheckImageHandle(const aHandle: TltsImageHandle; out aImage: TtsImage): Boolean;
function CheckCharHandle(const aHandle: TltsCharHandle; out aChar: TtsChar): Boolean;
function CheckPostProcessorHandle(const aHandle: TltsPostProcessorHandle; const aType: TtsPostProcessorClass; out aPostProcessor): Boolean;

procedure AddReference(const aType: TltsObjectType; const aRef: TObject);
procedure DelReference(const aType: TltsObjectType; const aRef: TObject);
procedure DelReference(const aRef: TObject);

function ValidateCodePage(const aValue: TtsCodePage): Boolean;
function ValidateFormat(const aValue: TtsFormat): Boolean;
function ValidateCharRangeUsage(const aValue: TtsCharRangeUsage): Boolean;

procedure Initialize;
procedure Finalize;

type
  TltsStreamImpl = class(TStream)
  private
    fStream: PltsStream;
  public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override; overload;

    constructor Create(const aStream: PltsStream);
  end;

var
  LastErrorCode:  TltsErrorCode = ltsErrNone;
  LastErrorMsg:   String;

implementation

{$IFDEF DUMP_HEAPTRACE}
uses
  heaptrc;
{$ENDIF}

type
  TtsContextHashSet       = specialize TutlHashSet<TtsContext>;
  TtsRendererHashSet      = specialize TutlHashSet<TtsRenderer>;
  TtsTextBlockHashSet     = specialize TutlHashSet<TtsTextBlock>;
  TtsFontHashSet          = specialize TutlHashSet<TtsFont>;
  TtsFontCreatorHashSet   = specialize TutlHashSet<TtsFontCreator>;
  TtsImageHashSet         = specialize TutlHashSet<TtsImage>;
  TtsPostProcessorHashSet = specialize TutlHashSet<TtsPostProcessor>;
  TtsCharHashSet          = specialize TutlHashSet<TtsChar>;

var
  IsInitilized:   Boolean = false;

  Contexts:       TtsContextHashSet       = nil;
  Renderers:      TtsRendererHashSet      = nil;
  TextBlocks:     TtsTextBlockHashSet     = nil;
  Fonts:          TtsFontHashSet          = nil;
  FontCreators:   TtsFontCreatorHashSet   = nil;
  Images:         TtsImageHashSet         = nil;
  PostProcessors: TtsPostProcessorHashSet = nil;
  Chars:          TtsCharHashSet          = nil;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure SetLastError(const aEx: Exception);
begin
  LastErrorCode := ltsErrUnknown;
  LastErrorMsg  := aEx.Message;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure SetLastError(const aErrorCode: TltsErrorCode; const aErrorMsg: String);
begin
  LastErrorCode := aErrorCode;
  LastErrorMsg  := aErrorMsg;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckIfInitialized: Boolean;
begin
  result := IsInitilized;
  if not result then
    SetLastError(ltsErrNotInitialized, 'libTextSuite has not been initialized. call ltsInitialize before using any other methods.');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckContextHandle(const aHandle: TltsContextHandle; out aContext: TtsContext): Boolean;
begin
  result := CheckIfInitialized;
  if result then begin
    aContext := TtsContext(aHandle);
    result := Contexts.Contains(aContext);
    if not result then
      SetLastError(ltsErrInvalidContextHandle, Format('0x%.16x is not a valid context handle', [{%H-}PtrUInt(aHandle)]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckRendererHandle(const aHandle: TltsContextHandle; out aRenderer: TtsRenderer): Boolean;
begin
  result := CheckIfInitialized;
  if result then begin
    aRenderer := TtsRenderer(aHandle);
    result := Renderers.Contains(aRenderer);
    if not result then
      SetLastError(ltsErrInvalidRendererHandle, Format('0x%.16x is not a valid renderer handle', [{%H-}PtrUInt(aHandle)]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckTextBlockHandle(const aHandle: TltsTextBlockHandle; out aTextBlock: TtsTextBlock): Boolean;
begin
  result := CheckIfInitialized;
  if result then begin
    aTextBlock := TtsTextBlock(aHandle);
    result := TextBlocks.Contains(aTextBlock);
    if not result then
      SetLastError(ltsErrInvalidTextBlockHandle, Format('0x%.16x is no a valid text block handle', [{%H-}PtrUInt(aHandle)]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckFontHandle(const aHandle: TltsFontHandle; out aFont: TtsFont): Boolean;
begin
  result := CheckIfInitialized;
  if result then begin
    aFont := TtsFont(aHandle);
    result := Fonts.Contains(aFont);
    if not result then
      SetLastError(ltsErrInvalidFontHandle, Format('0x%.16x is no a valid font handle', [{%H-}PtrUInt(aHandle)]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckFontCreatorHandle(const aHandle: TltsFontCreatorHandle; out aFontCreator: TtsFontCreator): Boolean;
begin
  result := CheckIfInitialized;
  if result then begin
    aFontCreator := TtsFontCreator(aHandle);
    result := FontCreators.Contains(aFontCreator);
    if not result then
      SetLastError(ltsErrInvalidFontCreatorHandle, Format('0x%.16x is no a valid font creator handle', [{%H-}PtrUInt(aHandle)]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckImageHandle(const aHandle: TltsImageHandle; out aImage: TtsImage): Boolean;
begin
  result := CheckIfInitialized;
  if result then begin
    aImage := TtsImage(aHandle);
    result := Images.Contains(aImage);
    if not result then
      SetLastError(ltsErrInvalidImageHandle, Format('0x%.16x is no a valid image handle', [{%H-}PtrUInt(aHandle)]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckCharHandle(const aHandle: TltsCharHandle; out aChar: TtsChar): Boolean;
begin
  result := CheckIfInitialized;
  if result then begin
    aChar := TtsChar(aHandle);
    result := Chars.Contains(aChar);
    if not result then
      SetLastError(ltsErrInvalidImageHandle, Format('0x%.16x is no a valid char handle', [{%H-}PtrUInt(aHandle)]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckPostProcessorHandle(const aHandle: TltsPostProcessorHandle; const aType: TtsPostProcessorClass; out aPostProcessor): Boolean;
begin
  result := CheckIfInitialized;
  if result then begin
    TtsPostProcessor(aPostProcessor) := TtsPostProcessor(aHandle);
    result := PostProcessors.Contains(TtsPostProcessor(aPostProcessor));
    if not result then begin
      SetLastError(ltsErrInvalidPostProcHandle, Format('0x%.16x is no a valid image handle', [{%H-}PtrUInt(aHandle)]));
      exit;
    end;
    result := (TtsPostProcessor(aPostProcessor) is aType);
    if not result then begin
      SetLastError(ltsErrInvalidType, Format('0x%.16x is no a %s post processor', [{%H-}PtrUInt(aHandle), aType.ClassName]));
      exit;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure AddReference(const aType: TltsObjectType; const aRef: TObject);
begin
  case aType of
    ltsObjTypeContext:        Contexts.Add(aRef as TtsContext);
    ltsObjTypeRenderer:       Renderers.Add(aRef as TtsRenderer);
    ltsObjTypeFont:           Fonts.Add(aRef as TtsFont);
    ltsObjTypeTextBlock:      TextBlocks.Add(aRef as TtsTextBlock);
    ltsObjTypeFontCreator:    FontCreators.Add(aRef as TtsFontCreator);
    ltsObjTypeImage:          Images.Add(aRef as TtsImage);
    ltsObjTypePostProcessor:  PostProcessors.Add(aRef as TtsPostProcessor);
    ltsObjTypeChar:           Chars.Add(aRef as TtsChar);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure DelReference(const aType: TltsObjectType; const aRef: TObject);
begin
  case aType of
    ltsObjTypeContext:        Contexts.Remove(aRef as TtsContext);
    ltsObjTypeRenderer:       Renderers.Remove(aRef as TtsRenderer);
    ltsObjTypeFont:           Fonts.Remove(aRef as TtsFont);
    ltsObjTypeTextBlock:      TextBlocks.Remove(aRef as TtsTextBlock);
    ltsObjTypeFontCreator:    FontCreators.Remove(aRef as TtsFontCreator);
    ltsObjTypeImage:          Images.Remove(aRef as TtsImage);
    ltsObjTypePostProcessor:  PostProcessors.Remove(aRef as TtsPostProcessor);
    ltsObjTypeChar:           Chars.Remove(aRef as TtsChar);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure DelReference(const aRef: TObject);
begin
  if (aRef is TtsRenderer) then
    DelReference(ltsObjTypeRenderer, aRef)
  else if (aRef is TtsTextBlock) then
    DelReference(ltsObjTypeTextBlock, aRef)
  else if (aRef is TtsFont) then
    DelReference(ltsObjTypeFont, aRef)
  else if (aRef is TtsContext) then
    DelReference(ltsObjTypeContext, aRef)
  else if (aRef is TtsFontCreator) then
    DelReference(ltsObjTypeFontCreator, aRef)
  else if (aRef is TtsImage) then
    DelReference(ltsObjTypeImage, aRef)
  else if (aRef is TtsPostProcessor) then
    DelReference(ltsObjTypePostProcessor, aRef)
  else if (aRef is TtsChar) then
    DelReference(ltsObjTypeChar, aRef);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ValidateCodePage(const aValue: TtsCodePage): Boolean;
begin
  result := (aValue >= Low(TtsCodePage)) and (aValue <= High(TtsCodePage));
  if not result then
    SetLastError(ltsErrInvalidEnum, Format('%d is not a valid code page value', [aValue]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ValidateFormat(const aValue: TtsFormat): Boolean;
begin
  result := (aValue >= Low(TtsFormat)) and (aValue <= High(TtsFormat));
  if not result then
    SetLastError(ltsErrInvalidEnum, Format('%d is not a valid format value', [aValue]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ValidateCharRangeUsage(const aValue: TtsCharRangeUsage): Boolean;
begin
  result := (aValue >= Low(TtsCharRangeUsage)) and (aValue <= High(TtsCharRangeUsage));
  if not result then
    SetLastError(ltsErrInvalidEnum, Format('%d is not a valid char range usage value', [aValue]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure Initialize;
{$IFDEF DUMP_HEAPTRACE}
var
  heaptrcFile: String;
{$ENDIF}
begin
{$IFDEF DUMP_HEAPTRACE}
  heaptrcFile := ChangeFileExt(ParamStr(0), '.libTextSuite.heaptrc');
  if (FileExists(heaptrcFile)) then
    DeleteFile(heaptrcFile);
  SetHeapTraceOutput(heaptrcFile);
{$ENDIF}

  Contexts       := TtsContextHashSet.Create(true);
  Renderers      := TtsRendererHashSet.Create(false);
  TextBlocks     := TtsTextBlockHashSet.Create(false);
  FontCreators   := TtsFontCreatorHashSet.Create(false);
  Fonts          := TtsFontHashSet.Create(false);
  Images         := TtsImageHashSet.Create(false);
  PostProcessors := TtsPostProcessorHashSet.Create(false);
  Chars          := TtsCharHashSet.Create(false);
  IsInitilized   := true;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure Finalize;
begin
  IsInitilized := false;
  FreeAndNil(Chars);
  FreeAndNil(PostProcessors);
  FreeAndNil(Images);
  FreeAndNil(TextBlocks);
  FreeAndNil(Fonts);
  FreeAndNil(FontCreators);
  FreeAndNil(Renderers);
  FreeAndNil(Contexts);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TltsStreamImpl////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TltsStreamImpl.Read(var Buffer; Count: Longint): Longint;
begin
  if not Assigned(fStream) or not Assigned(fStream^.read)
    then result := inherited Read(Buffer, Count)
    else result := fStream^.read(fStream^.args, @buffer, Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TltsStreamImpl.Seek(Offset: Longint; Origin: Word): Longint;
begin
  if not Assigned(fStream) or not Assigned(fStream^.seek)
    then result := inherited Seek(Offset, Origin)
    else result := fStream^.seek(fStream^.args, TltsStreamOrigin(Origin), Offset);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TltsStreamImpl.Create(const aStream: PltsStream);
begin
  inherited Create;
  fStream := aStream;
end;

end.