libTextSuite/header/examples/fpc/uMainForm.pas

unit uMainForm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  uglcContext, ulibTextSuite;

type
  TMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    fContext: TglcContext;
    fltsContext: TltsContext;
    fltsRenderer: TltsRendererOpenGL;
    fltsCreator: TltsFontCreatorGDI;
    fltsFont: TltsFont;
    fltsPostProcessorList: TltsPostProcessorList;
    procedure Render;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

uses
  dglOpenGL;

const
  {$IF DEFINED(WIN32)}
  LibName = '..\..\..\libTextSuite-i386-win32.dll';
  {$ELSEIF DEFINED(WIN64)}
  LibName = '..\..\..\libTextSuite-x86_64-win64.dll';
  {$ELSEIF DEFINED(LINUX) AND DEFINED(CPU32)}
  LibName = '../../../libTextSuite-i386-linux.so';
  {$ELSEIF DEFINED(LINUX) AND DEFINED(CPU64)}
  LibName = '../../../libTextSuite-x86_64-linux.so';
  {$ELSE}
    {$ERROR 'unknown operation system'}
  {$IFEND}

  TEST_TEXT = 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.';

  PATTER_DATA: array[0..15] of Byte = (
    $FF, $BF, $7F, $BF,
    $BF, $FF, $BF, $7F,
    $7F, $BF, $FF, $BF,
    $BF, $7F, $BF, $FF);

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//MainForm//////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FormCreate(Sender: TObject);
var
  pf: TglcContextPixelFormatSettings;
  pp: TltsPostProcessor;
  img: TltsImage;
begin
  ltsInitialize(LibName);

  pf := TglcContext.MakePF();
  fContext := TglcContext.GetPlatformClass.Create(self, pf);
  fContext.BuildContext;
  fContext.Activate;

  glDisable(GL_DEPTH_TEST);
  glDisable(GL_CULL_FACE);
  glClearColor(1.0, 1.0, 1.0, 1.0);

  fltsContext  := TltsContext.Create;
  fltsRenderer := TltsRendererOpenGL.Create(fltsContext, ltsFormatRGBA8);
  fltsCreator  := TltsFontCreatorGDI.Create(fltsContext);

  fltsPostProcessorList := TltsPostProcessorList.Create(fltsContext, true);

  img := TltsImage.Create(fltsContext);
  img.CreateEmpty(ltsFormatAlpha8, 4, 4);
  Move(PATTER_DATA[0], img.Data^, 16);
  pp := TltsPostProcessorFillPattern.Create(fltsContext, img, true, ltsPosition(0, 0), LTS_IMAGE_MODES_MODULATE_ALL, LTS_COLOR_CHANNELS_RGBA);
  pp.AddChars(ltsUsageInclude, 'Lorem');
  fltsPostProcessorList.Add(pp);

  pp := TltsPostProcessorFillColor.Create(fltsContext, ltsColor4f(0, 0, 0.5, 1), LTS_IMAGE_MODES_REPLACE_ALL, LTS_COLOR_CHANNELS_RGB);
  pp.AddChars(ltsUsageExclude, 'e');
  fltsPostProcessorList.Add(pp);

  pp := TltsPostProcessorBorder.Create(fltsContext, 3.0, 0.5, ltsColor4f(0.0, 0.5, 0.0, 1.0), true);
  pp.AddChars(ltsUsageInclude, 'e');
  fltsPostProcessorList.Add(pp);

  fltsFont := fltsCreator.GetFontByFile(ExpandFileName('../Prototype.ttf'), 40, [], ltsAANormal);
  fltsFont.PostProcessor := fltsPostProcessorList;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(fltsFont);
  FreeAndNil(fltsPostProcessorList);
  FreeAndNil(fltsCreator);
  FreeAndNil(fltsRenderer);
  FreeAndNil(fltsContext);
  FreeAndNil(fContext);
  ltsFinalize;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FormPaint(Sender: TObject);
begin
  Render;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FormResize(Sender: TObject);
begin
  if Assigned(fContext) then begin
    glViewport(0, 0, ClientWidth, ClientHeight);
    glMatrixMode(GL_PROJECTION);
    glLoadIdentity;
    glOrtho(0, ClientWidth, ClientHeight, 0, 10, -10);
    glMatrixMode(GL_MODELVIEW);
    glLoadIdentity;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.Render;
var
  block: TltsTextBlock;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glLoadIdentity;

  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);

  block := fltsRenderer.BeginBlock(10, 10, ClientWidth-20, ClientHeight-20, [ltsBlockFlagWordWrap]);
  try
    block.HorzAlign := ltsHorzAlignJustify;
    block.ChangeFont(fltsFont);
    block.ChangeColor(ltsColor4f(1.0, 1.0, 1.0, 1.0));
    block.TextOutW(TEST_TEXT);
  finally
    fltsRenderer.EndBlock(block);
  end;

  fContext.SwapBuffers;
end;

end.