libTextSuite/header/examples/fpc/uMainForm.pas

unit uMainForm;

{$mode objfpc}{$H+}

{$IFDEF LINUX}
  {$DEFINE USE_FREETYPE}
{$ENDIF}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  ulibTextSuite, dglOpenGL
  {$IF DEFINED(WIN32) OR DEFINED(WIN64)}
  , Windows
  {$ELSEIF DEFINED(LINUX)}
  , LCLType, LMessages, XUtil, XLib, gdk2x, gtk2, gdk2, WSLCLClasses, X, glib2
  , Gtk2Def, Gtk2Int, InterfaceBase, WSControls
  {$ENDIF};

type
{$IF DEFINED(LINUX)}
  TRenderControl = class(TWinControl)
  private
    fIntWidget: PGtkWidget;
    fVisualID: TVisualID;
    fTarget: TWinControl;
  protected
    function WSCreateHandle({%H-}const WSPrivate: TWSPrivateClass; const AParams: TCreateParams): TLCLIntfHandle;
    procedure WSBeforeDestroyHandle;
    procedure WndProc(var Message: TLMessage); override;
  public
    property Widget: PGtkWidget read FIntWidget;
    property Target: TWinControl read fTarget write fTarget;
    constructor Create(TheOwner: TComponent; const aVisualID: TVisualID); overload;
  end;

  TWSCustomVisualControl = class(TWSWinControl)
  published
    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
    class procedure DestroyHandle(const AWinControl: TWinControl); override;
  end;
{$ENDIF}

  TMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);

  private
    fCanRender: Boolean;
    fHasRenderContext: Boolean;

  {$IF DEFINED(WIN32) OR DEFINED(WIN64)}
    fDC: HDC;
    fRC: HGLRC;
    procedure CreateRenderContext;
    procedure DestroyRenderContext;
    procedure SwapBuffers;
  {$ELSEIF DEFINED(LINUX)}
    fVisual: PXVisualInfo;
    fDisplay: PDisplay;
    fWidget: PGtkWidget;
    fContext: GLXContext;
    fRenderControl: TRenderControl;
    procedure CreateRenderContext;
    procedure DestroyRenderContext;
    procedure SwapBuffers;
  {$ENDIF}

  private
    fltsContext: TltsContext;
    fltsRenderer: TltsRendererOpenGL;
    fltsCreator: {$IFDEF USE_FREETYPE}TltsFontCreatorFreeType{$ELSE}TltsFontCreatorGDI{$ENDIF};
    fltsFont: TltsFont;
    fltsPostProcessorList: TltsPostProcessorList;
    procedure Render;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IFDEF LINUX}
type
  TGLIntArray = packed array of GLInt;

  PGtkCustomWidget = ^TGtkCustomWidget;
  TGtkCustomWidget = record
    darea: TGtkDrawingArea;
  end;

  PGtkCustomWidgetClass = ^TGtkCustomWidgetClass;
  TGtkCustomWidgetClass = record
    parent_class: TGtkDrawingAreaClass;
  end;

var
  custom_widget_type:         TGtkType = 0;
  custom_widget_parent_class: Pointer  = nil;

function GTK_TYPE_CUSTOM_WIDGET: TGtkType; forward;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure g_return_if_fail(b: boolean; const Msg: string);
begin
  if not b then raise Exception.Create(Msg);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure g_return_if_fail(b: boolean);
begin
  g_return_if_fail(b,'');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function GTK_IS_CUSTOM_WIDGET(obj: Pointer): Boolean;
begin
  GTK_IS_CUSTOM_WIDGET:=GTK_CHECK_TYPE(obj,GTK_TYPE_CUSTOM_WIDGET);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function GTK_CUSTOM_WIDGET(obj: Pointer): PGtkCustomWidget;
begin
  g_return_if_fail(GTK_IS_CUSTOM_WIDGET(obj),'');
  Result := PGtkCustomWidget(obj);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure gtk_custom_widget_init(custom_widget: PGTypeInstance; theClass: gpointer); cdecl;
begin
  gtk_widget_set_double_buffered(PGtkWidget(custom_widget),gdkFALSE);
  GTK_WIDGET_UNSET_FLAGS(PGtkWidget(custom_widget),GTK_NO_WINDOW);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure gtk_custom_widget_destroy(obj: PGtkObject); cdecl;
begin
  g_return_if_fail (obj <>nil,'');
  g_return_if_fail (GTK_IS_CUSTOM_WIDGET(obj),'');

  if Assigned(GTK_OBJECT_CLASS(custom_widget_parent_class)^.destroy) then
    GTK_OBJECT_CLASS(custom_widget_parent_class)^.destroy(obj);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure gtk_custom_widget_class_init(klass: Pointer); cdecl;
var
  object_class: PGtkObjectClass;
begin
  custom_widget_parent_class := gtk_type_class(gtk_drawing_area_get_type());
  g_return_if_fail(custom_widget_parent_class<>nil,'gtk_custom_widget_class_init parent_class=nil');
  object_class := PGtkObjectClass(klass);
  g_return_if_fail(object_class<>nil,'gtk_custom_widget_class_init object_class=nil');
  object_class^.destroy := @gtk_custom_widget_destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function custom_widget_size_allocateCB(Widget: PGtkWidget; Size: pGtkAllocation; Data: gPointer): GBoolean; cdecl;
const
  CallBackDefaultReturn = {$IFDEF GTK2}false{$ELSE}true{$ENDIF};
var
  SizeMsg: TLMSize;
  GtkWidth, GtkHeight: integer;
  LCLControl: TWinControl;
begin
  Result := CallBackDefaultReturn;
  if not GTK_WIDGET_REALIZED(Widget) then begin
    // the widget is not yet realized, so this GTK resize was not a user change.
    // => ignore
    exit;
  end;
  if Size=nil then ;
  LCLControl:=TWinControl(Data);
  if LCLControl=nil then exit;
  //DebugLn(['gtkglarea_size_allocateCB ',DbgSName(LCLControl)]);

  gtk_widget_get_size_request(Widget, @GtkWidth, @GtkHeight);

  SizeMsg.Msg:=0;
  FillChar(SizeMsg,SizeOf(SizeMsg),0);
  with SizeMsg do
  begin
    Result := 0;
    Msg := LM_SIZE;
    SizeType := Size_SourceIsInterface;
    Width := SmallInt(GtkWidth);
    Height := SmallInt(GtkHeight);
  end;
  //DebugLn(['gtkglarea_size_allocateCB ',GtkWidth,',',GtkHeight]);
  LCLControl.WindowProc(TLMessage(SizeMsg));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function GTK_TYPE_CUSTOM_WIDGET: TGtkType;
const
  custom_widget_type_name = 'GtkGLArea';
  custom_widget_info: TGtkTypeInfo = (
    type_name: custom_widget_type_name;
    object_size: SizeOf(TGtkCustomWidget);
    class_size:  SizeOf(TGtkCustomWidgetClass);
    class_init_func:  @gtk_custom_widget_class_init;
    object_init_func: @gtk_custom_widget_init;
    reserved_1: nil;
    reserved_2: nil;
    base_class_init_func: nil;);
begin
  if (custom_widget_type=0) then begin
    custom_widget_type:=gtk_type_unique(gtk_drawing_area_get_type(),@custom_widget_info);
  end;
  Result:=custom_widget_type;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CreateOpenGLContextAttrList(UseFB: boolean; aDoubleBuffered: Boolean; aColorBits, aDepthBits: Integer): TGLIntArray;
var
  p: integer;

  procedure Add(i: integer);
  begin
    SetLength(Result, p+1);
    Result[p]:=i;
    inc(p);
  end;

  procedure CreateList;
  begin
    if UseFB then begin Add(GLX_X_RENDERABLE); Add(1); end;
    if aDoubleBuffered then begin
      if UseFB then begin
        Add(GLX_DOUBLEBUFFER); Add(1);
      end else
        Add(GLX_DOUBLEBUFFER);
    end;
    if not UseFB and (aColorBits > 24) then Add(GLX_RGBA);
    if UseFB then begin
      Add(GLX_DRAWABLE_TYPE);
      Add(GLX_WINDOW_BIT);
    end;
    Add(GLX_RED_SIZE);      Add(8);
    Add(GLX_GREEN_SIZE);    Add(8);
    Add(GLX_BLUE_SIZE);     Add(8);
    if (aColorBits > 24) then
      Add(GLX_ALPHA_SIZE);  Add(8);
    Add(GLX_DEPTH_SIZE);    Add(aDepthBits);
    Add(GLX_STENCIL_SIZE);  Add(0);
    Add(GLX_AUX_BUFFERS);   Add(0);

    Add(0); { 0 = X.None (be careful: GLX_NONE is something different) }
  end;

begin
  SetLength(Result, 0);
  p := 0;
  CreateList;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function FBglXChooseVisual(dpy:PDisplay; screen:longint; attrib_list:Plongint):PXVisualInfo;
type
  PGLXFBConfig = ^GLXFBConfig;
var
  FBConfigsCount: integer;
  FBConfigs: PGLXFBConfig;
  FBConfig: GLXFBConfig;
begin
  Result:= nil;
  FBConfigsCount:=0;
  FBConfigs:= glXChooseFBConfig(dpy, screen, attrib_list, @FBConfigsCount);
  if FBConfigsCount = 0 then
    exit;

  { just choose the first FB config from the FBConfigs list.
    More involved selection possible. }
  FBConfig := FBConfigs^;
  Result:=glXGetVisualFromFBConfig(dpy, FBConfig);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TRenderControl////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TRenderControl.WSCreateHandle(const WSPrivate: TWSPrivateClass; const AParams: TCreateParams): TLCLIntfHandle;
var
  cmap: PGdkColormap;
  gdkvis: PGdkVisual;
begin
  // is the requested VisualID different from what the widget would get?
  cmap  := gdk_colormap_get_system;
  gdkvis:= gdk_colormap_get_visual(cmap);
  if XVisualIDFromVisual(gdk_x11_visual_get_xvisual(gdkvis)) <> FVisualID then begin
    gdkvis := gdkx_visual_get(FVisualID);
    cmap   := gdk_colormap_new(gdkvis, false);
  end;

  fIntWidget := gtk_type_new(GTK_TYPE_CUSTOM_WIDGET);
  gtk_widget_set_colormap(fIntWidget, cmap);

  Result := TLCLIntfHandle({%H-}PtrUInt(fIntWidget));
  PGtkobject(fIntWidget)^.flags:= PGtkobject(fIntWidget)^.flags or GTK_CAN_FOCUS;
  TGTK2WidgetSet(WidgetSet).FinishCreateHandle(Self,fIntWidget,AParams);
  g_signal_connect_after(fIntWidget, 'size-allocate', TGTKSignalFunc(@custom_widget_size_allocateCB), Self);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TRenderControl.WSBeforeDestroyHandle;
begin
  if not HandleAllocated then exit;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TRenderControl.WndProc(var Message: TLMessage);
begin
  case Message.msg of
    //LM_ACTIVATEITEM,
    //LM_CHANGED,
    //LM_FOCUS,
    LM_CLICKED,
    //LM_RELEASED,
    LM_ENTER,
    LM_LEAVE,
    //LM_CHECKRESIZE,
    //LM_SETEDITABLE,
    //LM_MOVEWORD,
    //LM_MOVEPAGE,
    //LM_MOVETOROW,
    //LM_MOVETOCOLUMN,
    //LM_KILLCHAR,
    //LM_KILLWORD,
    //LM_KILLLINE,
    //LM_CLOSEQUERY,
    //LM_DRAGSTART,
    //LM_MONTHCHANGED,
    //LM_YEARCHANGED,
    //LM_DAYCHANGED,
    LM_LBUTTONTRIPLECLK,
    LM_LBUTTONQUADCLK,
    LM_MBUTTONTRIPLECLK,
    LM_MBUTTONQUADCLK,
    LM_RBUTTONTRIPLECLK,
    LM_RBUTTONQUADCLK,
    LM_MOUSEENTER,
    LM_MOUSELEAVE,
    LM_XBUTTONTRIPLECLK,
    LM_XBUTTONQUADCLK,

    //SC_SIZE,
    //SC_MOVE,
    //SC_MINIMIZE,
    //SC_MAXIMIZE,
    //SC_NEXTWINDOW,
    //SC_PREVWINDOW,
    //SC_CLOSE,
    SC_VSCROLL,
    SC_HSCROLL,
    SC_MOUSEMENU,
    SC_KEYMENU,
    //SC_ARRANGE,
    //SC_RESTORE,
    //SC_TASKLIST,
    //SC_SCREENSAVE,
    //SC_HOTKEY,
    //SC_DEFAULT,
    //SC_MONITORPOWER,
    //SC_CONTEXTHELP,
    //SC_SEPARATOR,

    //LM_MOVE,
    //LM_SIZE,
    LM_ACTIVATE,
    LM_SETFOCUS,
    LM_KILLFOCUS,
    //LM_ENABLE,
    //LM_GETTEXTLENGTH,
    //LM_SHOWWINDOW,
    //LM_CANCELMODE,
    //LM_DRAWITEM,
    //LM_MEASUREITEM,
    //LM_DELETEITEM,
    //LM_VKEYTOITEM,
    //LM_CHARTOITEM,
    //LM_COMPAREITEM,
    //LM_WINDOWPOSCHANGING,
    //LM_WINDOWPOSCHANGED,
    //LM_NOTIFY,
    //LM_HELP,
    //LM_NOTIFYFORMAT,
    //LM_CONTEXTMENU,
    //LM_NCCALCSIZE,
    //LM_NCHITTEST,
    //LM_NCPAINT,
    //LM_NCACTIVATE,
    //LM_GETDLGCODE,
    LM_NCMOUSEMOVE,
    LM_NCLBUTTONDOWN,
    LM_NCLBUTTONUP,
    LM_NCLBUTTONDBLCLK,
    LM_KEYDOWN,
    LM_KEYUP,
    LM_CHAR,
    LM_SYSKEYDOWN,
    LM_SYSKEYUP,
    LM_SYSCHAR,
    LM_COMMAND,
    LM_SYSCOMMAND,
    LM_TIMER,
    LM_HSCROLL,
    LM_VSCROLL,
    //LM_CTLCOLORMSGBOX,
    //LM_CTLCOLOREDIT,
    //LM_CTLCOLORLISTBOX,
    //LM_CTLCOLORBTN,
    //LM_CTLCOLORDLG,
    //LM_CTLCOLORSCROLLBAR,
    //LM_CTLCOLORSTATIC,
    LM_MOUSEMOVE,
    LM_LBUTTONDOWN,
    LM_LBUTTONUP,
    LM_LBUTTONDBLCLK,
    LM_RBUTTONDOWN,
    LM_RBUTTONUP,
    LM_RBUTTONDBLCLK,
    LM_MBUTTONDOWN,
    LM_MBUTTONUP,
    LM_MBUTTONDBLCLK,
    LM_MOUSEWHEEL,
    LM_XBUTTONDOWN,
    LM_XBUTTONUP,
    LM_XBUTTONDBLCLK,
    //LM_PARENTNOTIFY,
    //LM_CAPTURECHANGED,
    //LM_DROPFILES,
    //LM_SELCHANGE,
    LM_CUT,
    LM_COPY,
    LM_PASTE,
    //LM_CLEAR,
    //LM_CONFIGUREEVENT,
    //LM_EXIT,
    //LM_QUIT,
    //LM_NULL,
    //LM_PAINT,
    //LM_ERASEBKGND,
    //LM_SETCURSOR,
    //LM_SETFONT:

    //CM_ACTIVATE,
    //CM_DEACTIVATE,
    //CM_FOCUSCHANGED,
    //CM_PARENTFONTCHANGED,
    //CM_PARENTCOLORCHANGED,
    //CM_HITTEST,
    //CM_VISIBLECHANGED,
    //CM_ENABLEDCHANGED,
    //CM_COLORCHANGED,
    //CM_FONTCHANGED,
    //CM_CURSORCHANGED,
    //CM_TEXTCHANGED,
    CM_MOUSEENTER,
    CM_MOUSELEAVE,
    //CM_MENUCHANGED,
    //CM_APPSYSCOMMAND,
    //CM_BUTTONPRESSED,
    //CM_SHOWINGCHANGED,
    //CM_ENTER,
    //CM_EXIT,
    //CM_DESIGNHITTEST,
    //CM_ICONCHANGED,
    //CM_WANTSPECIALKEY,
    //CM_RELEASE,
    //CM_FONTCHANGE,
    //CM_TABSTOPCHANGED,
    //CM_UIACTIVATE,
    //CM_CONTROLLISTCHANGE,
    //CM_GETDATALINK,
    //CM_CHILDKEY,
    //CM_HINTSHOW,
    //CM_SYSFONTCHANGED,
    //CM_CONTROLCHANGE,
    //CM_CHANGED,
    //CM_BORDERCHANGED,
    //CM_BIDIMODECHANGED,
    //CM_PARENTBIDIMODECHANGED,
    //CM_ALLCHILDRENFLIPPED,
    //CM_ACTIONUPDATE,
    //CM_ACTIONEXECUTE,
    //CM_HINTSHOWPAUSE,
    //CM_DOCKNOTIFICATION,
    CM_MOUSEWHEEL,
    //CM_APPSHOWBTNGLYPHCHANGED,
    //CM_APPSHOWMENUGLYPHCHANGED,

    //CN_BASE,
    //CN_CHARTOITEM,
    //CN_COMMAND,
    //CN_COMPAREITEM,
    //CN_CTLCOLORBTN,
    //CN_CTLCOLORDLG,
    //CN_CTLCOLOREDIT,
    //CN_CTLCOLORLISTBOX,
    //CN_CTLCOLORMSGBOX,
    //CN_CTLCOLORSCROLLBAR,
    //CN_CTLCOLORSTATIC,
    //CN_DELETEITEM,
    //CN_DRAWITEM,
    CN_HSCROLL,
    //CN_MEASUREITEM,
    //CN_PARENTNOTIFY,
    //CN_VKEYTOITEM,
    CN_VSCROLL,
    CN_KEYDOWN,
    CN_KEYUP,
    CN_CHAR,
    CN_SYSKEYUP,
    CN_SYSKEYDOWN,
    CN_SYSCHAR,
    CN_NOTIFY:
    begin
      if Assigned(fTarget) then
        Message.Result := fTarget.Perform(Message.msg, Message.wParam, Message.lParam);
    end;
  end;
  inherited WndProc(Message);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TRenderControl.Create(TheOwner: TComponent; const aVisualID: TVisualID);
begin
  inherited Create(TheOwner);
  fIntWidget := nil;
  fVisualID  := aVisualID;
  SetBounds(0, 0, 200, 200);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TWSCustomVisualControl////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TWSCustomVisualControl.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle;
begin
  if csDesigning in AWinControl.ComponentState then begin
    // do not use "inherited CreateHandle", because the LCL changes the hierarchy at run time
    Result:= TWSWinControlClass(ClassParent).CreateHandle(AWinControl,AParams);
  end else
    Result:= (AWinControl as TRenderControl).WSCreateHandle(WSPrivate, AParams);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TWSCustomVisualControl.DestroyHandle(const AWinControl: TWinControl);
begin
  (AWinControl as TRenderControl).WSBeforeDestroyHandle;
  // do not use "inherited DestroyHandle", because the LCL changes the hierarchy at run time
  TWSWinControlClass(ClassParent).DestroyHandle(AWinControl);
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//MainForm//////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FormCreate(Sender: TObject);
var
  pp: TltsPostProcessor;
  img: TltsImage;
begin
  CreateRenderContext;
  glDisable(GL_DEPTH_TEST);
  glDisable(GL_CULL_FACE);
  glClearColor(1.0, 1.0, 1.0, 1.0);

  ltsInitialize(LibName);
  Caption := 'libTextSuite example (Version: ' + ltsGetVersion() + ')';

  fltsContext  := TltsContext.Create;
  fltsRenderer := TltsRendererOpenGL.Create(fltsContext, ltsFormatRGBA8);
  fltsCreator  := {$IFDEF USE_FREETYPE}TltsFontCreatorFreeType{$ELSE}TltsFontCreatorGDI{$ENDIF}.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;

  fCanRender := true;
end;

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

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

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IF DEFINED(WIN32) OR DEFINED(WIN64)}
procedure TMainForm.CreateRenderContext;

  function FindPixelFormat: Integer;
  const
    MemoryDCs = [OBJ_MEMDC, OBJ_METADC, OBJ_ENHMETADC];
  var
    AType: DWord;
    PFDescriptor: TPixelFormatDescriptor;
  begin
    result := 0;
    FillChar(PFDescriptor{%H-}, SizeOf(PFDescriptor), #0);
    with PFDescriptor do begin
      nSize    := SizeOf(PFDescriptor);
      nVersion := 1;
      dwFlags  := PFD_SUPPORT_OPENGL;
      AType    := GetObjectType(fDC);
      if AType = 0 then
        raise Exception.Create('unable to get device context object type');
      dwFlags := dwFlags or PFD_DOUBLEBUFFER;
      if AType in MemoryDCs then
        dwFlags := dwFlags or PFD_DRAW_TO_BITMAP
      else
        dwFlags := dwFlags or PFD_DRAW_TO_WINDOW;

      iPixelType   := PFD_TYPE_RGBA;
      cColorBits   := 32;
      cDepthBits   := 24;
      cStencilBits := 0;
      cAccumBits   := 0;
      cAuxBuffers  := 0;
      iLayerType   := PFD_MAIN_PLANE;
    end;
    result := ChoosePixelFormat(fDC, @PFDescriptor);
  end;

var
  pf: Integer;
  err: DWORD;
begin
  InitOpenGL;

  fDC := GetDC(Handle);
  if (fDC = 0) then
    raise Exception.Create('unable to get device context');

  pf := FindPixelFormat;
  if not SetPixelFormat(fDC, pf, nil) then begin
    ReleaseDC(Handle, fDC);
    raise Exception.CreateFmt('Cannot set PF %d on Control %x DC %d', [pf, Handle, FDC]);
  end;

  fRC := wglCreateContext(FDC);
  if (fRC = 0) then begin
    ReleaseDC(Handle, FDC);
    raise Exception.CreateFmt('Cannot create context on Control %x DC %d', [pf, Handle, FDC]);
  end;

  if not wglMakeCurrent(fDC, fRC) then begin
    err := GetLastError;
    raise Exception.Create('unable to activate context: (' + IntToStr(err) + ') ' + SysErrorMessage(err));
  end;

  ReadOpenGLCore;
  ReadExtensions;
  ReadImplementationProperties;

  fHasRenderContext := true;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.DestroyRenderContext;
begin
  wglMakeCurrent(0, 0);
  DestroyRenderingContext(fRC);
  ReleaseDC(Handle, fDC);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.SwapBuffers;
begin
  Windows.SwapBuffers(fDC);
end;

{$ELSEIF DEFINED(LINUX)}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.CreateRenderContext;

  procedure UpdateVisual;
  var
    attrList: TGLIntArray;
    drawable: PGdkDrawable;
  begin
    { Temporary (realized) widget to get to display }
    fWidget:= {%H-}PGtkWidget(PtrUInt(Handle));
    gtk_widget_realize(fWidget);
    drawable := GTK_WIDGET(fWidget)^.window;
    fDisplay := GDK_WINDOW_XDISPLAY(drawable);

    { Find a suitable visual from PixelFormat using GLX 1.3 FBConfigs or
      old-style Visuals }
    if Assigned(glXChooseFBConfig) then begin
      attrList := CreateOpenGLContextAttrList(true, true, 32, 24);
      fVisual  := FBglXChooseVisual(FDisplay, DefaultScreen(FDisplay), @attrList[0]);
    end;
    if not Assigned(fVisual) then begin
      attrList := CreateOpenGLContextAttrList(false, true, 32, 24);
      fVisual  := glXChooseVisual(FDisplay, DefaultScreen(FDisplay), @attrList[0]);
    end;
    if not Assigned(fVisual) then
      raise Exception.Create('choose visual failed');

    { Most widgets inherit the drawable of their parent. In contrast to Windows, descending from
      TWinControl does not mean it's actually always a window of its own.
      Famous example: TPanel is just a frame painted on a canvas.
      Also, the LCL does somethin weird to colormaps in window creation, so we have
      to use a custom widget here to have full control about visual selection. }
    fRenderControl:= TRenderControl.Create(self, fVisual^.visual^.visualid);
    try
      fRenderControl.Parent := self;
      fRenderControl.HandleNeeded;
      fRenderControl.Target := self;
    except
      FreeAndNil(fRenderControl);
      raise;
    end;

    { Real Widget handle, unrealized!!! }
    fWidget := fRenderControl.Widget;
    gtk_widget_realize(fWidget);
    drawable := GTK_WIDGET(fWidget)^.window;
    FDisplay := GDK_WINDOW_XDISPLAY(drawable);

    // fRenderControl.Align:= alClient breaks the context or something
    fRenderControl.BoundsRect := ClientRect;
    fRenderControl.Anchors    := [akLeft, akTop, akRight, akBottom];
  end;

var
  glxID: GLXDrawable;
begin
  InitOpenGL;
  UpdateVisual;
  if not Assigned(FVisual) then
    raise Exception.Create('Failed to find Visual');

  fContext := glXCreateContext(FDisplay, FVisual, nil, true);
  if not Assigned(fContext) then
    raise Exception.Create('Failed to create Context');

  gtk_widget_realize(fWidget);
  if not GTK_WIDGET_REALIZED(fWidget) then
    exit;

  glxID := GDK_DRAWABLE_XID(GTK_WIDGET(fWidget)^.window);
  glXMakeCurrent(fDisplay, glxID, fContext);

  ReadOpenGLCore;
  ReadExtensions;
  ReadImplementationProperties;

  fHasRenderContext := true;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.DestroyRenderContext;
var
  glxID: GLXDrawable;
begin
  glxID := GDK_DRAWABLE_XID(GTK_WIDGET(fWidget)^.window);
  glXMakeCurrent(FDisplay, glxID, nil);
  if Assigned(fContext) then
    glXDestroyContext(fDisplay, fContext);
  FreeAndNil(fRenderControl);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.SwapBuffers;
var
  glxID: GLXDrawable;
begin
  if not Assigned(fWidget) then
    exit;
  glxID := GDK_DRAWABLE_XID(GTK_WIDGET(fWidget)^.window);
  glXSwapBuffers(fDisplay, glxID);
end;
{$ENDIF}

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

  SwapBuffers;
end;

{$IFDEF LINUX}
initialization
  RegisterWSComponent(TRenderControl, TWSCustomVisualControl);
{$ENDIF}

end.