first standalone gtk3 app, refactored to packages FresnelBase, Fresnel, FresnelLCL

demo/Button/.gitignore

@@ -0,0 +1 @@
+ButtonSkia

demo/Button/ButtonSkia.lpi

@@ -0,0 +1,76 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="ButtonSkia"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="Fresnel"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="ButtonSkia.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="MainUnit.pas"/>
+        <IsPartOfProject Value="True"/>
+        <HasResources Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="ButtonSkia"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf2"/>
+      </Debugging>
+    </Linking>
+    <Other>
+      <ConfigFile>
+        <WriteConfigFilePath Value=""/>
+      </ConfigFile>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

demo/Button/ButtonSkia.lpr

@@ -0,0 +1,12 @@
+program ButtonSkia;
+
+uses
+  Fresnel, // initializes the widgetset
+  Fresnel.App, MainUnit;
+
+begin
+  Application.Initialize;
+  Application.CreateGlobal(TMainForm,MainForm);
+  Application.Run;
+end.
+

demo/Button/MainUnit.lfm

@@ -0,0 +1,24 @@
+object MainForm: TMainForm
+  Caption = 'MainForm'
+  FormHeight = 255
+  FormLeft = 450
+  FormTop = 300
+  FormWidth = 350
+  Stylesheet.Strings = (
+    'div {'
+    '  padding: 3px; '
+    '  border: 2px; '
+    '  margin: 6px;'
+    '}'
+  )
+  object Body1: TBody
+    Style = 'border: 2px;'#10'border-color: blue;'
+    object Div1: TDiv
+      Style = 'background-color: blue;'#10'border-color: black;'#10'height:50px;'
+      object Label1: TLabel
+        Caption = 'Label1'
+        Style = 'color: red;'
+      end
+    end
+  end
+end

demo/Button/MainUnit.pas

@@ -0,0 +1,28 @@
+unit MainUnit;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Fresnel.Forms, Fresnel.Controls;
+
+type
+  TMainForm = class(TFresnelForm)
+    Body1: TBody;
+    Div1: TDiv;
+    Label1: TLabel;
+  private
+  public
+
+  end;
+
+var
+  MainForm: TMainForm;
+
+implementation
+
+{$R *.lfm}
+
+end.
+

demo/LCLButton/.gitignore

@@ -0,0 +1 @@
+LCLButton

demo/LCLButton/FreBtnForm.lfm

@@ -0,0 +1,24 @@
+object FresnelButtonForm: TFresnelButtonForm
+  Caption = 'FresnelButtonForm'
+  FormLeft = 450
+  FormTop = 300
+  FormWidth = 350
+  FormHeight = 255
+  Stylesheet.Strings = (
+    'div {'
+    '  padding: 3px; '
+    '  border: 2px; '
+    '  margin: 6px;'
+    '}'
+  )
+  object Body1: TBody
+    Style = 'border: 2px;'#10'border-color: blue;'
+    object Div1: TDiv
+      Style = 'background-color: blue;'#10'border-color: black;'#10'height:50px;'
+      object Label1: TLabel
+        Style = 'color: green;'
+        Caption = 'Label1'
+      end
+    end
+  end
+end

demo/LCLButton/FreBtnForm.pas

@@ -0,0 +1,31 @@
+{
+  A Fresnel form inside an LCL application.
+  It requires the project (lpr) to use unit Fresnel from package FresnelLCL
+  in order to initialize the Fresnel-LCL widgetset.
+}
+unit FreBtnForm;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Fresnel.Forms, Fresnel.Controls;
+
+type
+  TFresnelButtonForm = class(TFresnelForm)
+    Body1: TBody;
+    Div1: TDiv;
+    Label1: TLabel;
+  public
+  end;
+
+var
+  FresnelButtonForm: TFresnelButtonForm;
+
+implementation
+
+{$R *.lfm}
+
+end.
+

demo/LCLButton/LCLButton.lpi

@@ -0,0 +1,90 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="LCLButton"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="FresnelLCL"/>
+      </Item>
+      <Item>
+        <PackageName Value="LCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="LCLButton.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="MainUnit.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="MainForm"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit>
+      <Unit>
+        <Filename Value="FreBtnForm.pas"/>
+        <IsPartOfProject Value="True"/>
+        <HasResources Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="LCLButton"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf2"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <ConfigFile>
+        <WriteConfigFilePath Value=""/>
+      </ConfigFile>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

demo/LCLButton/LCLButton.lpr

@@ -0,0 +1,25 @@
+program LCLButton;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  {$IFDEF HASAMIGA}
+  athreads,
+  {$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Fresnel, // this includes the Fresnel-LCL widgetset
+  Forms, MainUnit, FreBtnForm;
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TMainForm, MainForm);
+  Application.Run;
+end.
+

demo/LCLButton/MainUnit.lfm

@@ -0,0 +1,9 @@
+object MainForm: TMainForm
+  Left = 247
+  Height = 240
+  Top = 250
+  Width = 320
+  Caption = 'MainForm'
+  LCLVersion = '3.99.0.0'
+  OnPaint = FormPaint
+end

demo/LCLButton/MainUnit.pas

@@ -0,0 +1,48 @@
+{
+  This is the MainForm of the LCL application.
+  Once it is shown, it automatically opens the fresnel form.
+}
+unit MainUnit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, FreBtnForm;
+
+type
+
+  { TMainForm }
+
+  TMainForm = class(TForm)
+    procedure FormPaint(Sender: TObject);
+  private
+    FQueued: boolean;
+    procedure ShowFresnelForm({%H-}Data: PtrInt);
+  public
+  end;
+
+var
+  MainForm: TMainForm;
+
+implementation
+
+{$R *.lfm}
+
+{ TMainForm }
+
+procedure TMainForm.FormPaint(Sender: TObject);
+begin
+  if FQueued then exit;
+  FQueued:=true;
+  Application.QueueAsyncCall(@ShowFresnelForm,0)
+end;
+
+procedure TMainForm.ShowFresnelForm(Data: PtrInt);
+begin
+  FresnelButtonForm:=TFresnelButtonForm.Create(Self);
+end;
+
+end.
+

design/fresnel.register.pas

@@ -17,7 +17,8 @@ interface
 uses
   LCLProc, LCLType, Classes, SysUtils, FormEditingIntf, PropEdits, LCLIntf,
   Graphics, Controls, Forms, ProjectIntf, LazLoggerBase, Fresnel.DOM,
-  Fresnel.Controls, Fresnel.LCLControls, Fresnel.StylePropEdit;
+  Fresnel.Controls, Fresnel.Forms, Fresnel.Renderer, Fresnel.Classes,
+  Fresnel.LCLApp, Fresnel.LCL, Fresnel.StylePropEdit;
 
 type
 
@@ -26,6 +27,7 @@ type
   TFresnelFormMediator = class(TDesignerMediator,IFresnelFormDesigner)
   private
     FDsgnForm: TFresnelForm;
+    FRenderer: TFresnelLCLRenderer;
   protected
     procedure Notification(AComponent: TComponent; Operation: TOperation);
       override;
@@ -51,11 +53,13 @@ type
     procedure SetBounds(AComponent: TComponent; NewBounds: TRect); override;
   public
     // needed by Fresnel
-    procedure InvalidateRect(Sender: TObject; ARect: TRect; Erase: boolean);
-    procedure SetDesignerFormBounds(Sender: TObject; NewBounds: TRect);
-    function GetDesignerClientHeight: integer;
-    function GetDesignerClientWidth: integer;
+    procedure InvalidateRect(Sender: TObject; ARect: TRect; Erase: boolean); virtual;
+    procedure SetDesignerFormBounds(Sender: TObject; NewBounds: TRect); virtual;
+    function GetDesignerClientHeight: integer; virtual;
+    function GetDesignerClientWidth: integer; virtual;
+    function GetRenderer: TFresnelRenderer; virtual;
     property DsgnForm: TFresnelForm read FDsgnForm;
+    property Renderer: TFresnelLCLRenderer read FRenderer;
   end;
 
   { TFileDescPascalUnitWithFresnelForm }
@@ -115,6 +119,11 @@ begin
       FDsgnForm.Designer:=nil;
       FDsgnForm:=nil;
     end;
+    if FRenderer=AComponent then
+    begin
+      FRenderer.Canvas:=nil;
+      FRenderer:=nil;
+    end;
   end;
 end;
 
@@ -122,20 +131,32 @@ procedure TFresnelFormMediator.SetLCLForm(const AValue: TForm);
 begin
   if LCLForm=AValue then exit;
   inherited SetLCLForm(AValue);
-  if FDsgnForm=nil then exit;
-  FDsgnForm.Canvas:=LCLForm.Canvas;
+  if FDsgnForm<>nil then
+  begin
+    if FRenderer<>nil then
+      FRenderer.Canvas:=LCLForm.Canvas;
+    TFresnelLCLFontEngine(FDsgnForm.FontEngine).Canvas:=LCLForm.Canvas;
+  end else begin
+    if FRenderer<>nil then
+      FRenderer.Canvas:=nil;
+    TFresnelLCLFontEngine(FDsgnForm.FontEngine).Canvas:=nil;
+  end;
 end;
 
 class function TFresnelFormMediator.CreateMediator(TheOwner, aForm: TComponent
   ): TDesignerMediator;
 var
   Mediator: TFresnelFormMediator;
+  aFresnelForm: TFresnelForm;
 begin
   Result:=inherited CreateMediator(TheOwner,aForm);
   Mediator:=TFresnelFormMediator(Result);
-  Mediator.FDsgnForm:=aForm as TFresnelForm;
-  Mediator.FDsgnForm.Designer:=Mediator;
+  aFresnelForm:=aForm as TFresnelForm;
+  Mediator.FDsgnForm:=aFresnelForm;
+  aFresnelForm.Designer:=Mediator;
   Mediator.FreeNotification(aForm);
+
+  aFresnelForm.FontEngine:=TFresnelLCLFontEngine.Create(Mediator);
 end;
 
 class function TFresnelFormMediator.FormClass: TComponentClass;
@@ -151,7 +172,7 @@ var
 begin
   if AComponent=FDsgnForm then
   begin
-    CurBounds:=FDsgnForm.FormBoundsRect;
+    CurBounds:=FDsgnForm.FormBounds.GetRect;
   end else if AComponent is TFresnelElement then
   begin
     El:=TFresnelElement(AComponent);
@@ -168,7 +189,7 @@ begin
   //debugln(['TFresnelFormMediator.SetBounds ',DbgSName(AComponent),' ',dbgs(NewBounds)]);
   if AComponent=FDsgnForm then
   begin
-    FDsgnForm.FormBoundsRect:=NewBounds;
+    FDsgnForm.FormBounds:=TFresnelRect.Create(NewBounds);
   end else if AComponent is TFresnelElement then
   begin
     // bounds are controlled by CSS
@@ -183,7 +204,7 @@ procedure TFresnelFormMediator.GetClientArea(AComponent: TComponent; out
 begin
   if AComponent=FDsgnForm then
   begin
-    CurClientArea:=FDsgnForm.Form.ClientRect;
+    CurClientArea:=Rect(0,0,round(FDsgnForm.Width),round(FDsgnForm.Height));
     ScrollOffset:=Point(0,0);
   end else begin
     inherited GetClientArea(AComponent, CurClientArea, ScrollOffset);
@@ -293,7 +314,7 @@ end;
 function TFresnelFormMediator.GetDesignerClientHeight: integer;
 begin
   if LCLForm=nil then
-    Result:=FDsgnForm.Form.ClientHeight
+    Result:=round(FDsgnForm.Height)
   else
     Result:=LCLForm.ClientHeight;
 end;
@@ -301,11 +322,21 @@ end;
 function TFresnelFormMediator.GetDesignerClientWidth: integer;
 begin
   if LCLForm=nil then
-    Result:=FDsgnForm.Form.ClientWidth
+    Result:=round(FDsgnForm.Width)
   else
     Result:=LCLForm.ClientWidth;
 end;
 
+function TFresnelFormMediator.GetRenderer: TFresnelRenderer;
+begin
+  if FRenderer=nil then
+  begin
+    FRenderer:=TFresnelLCLRenderer.Create(Self);
+    Renderer.Canvas:=LCLForm.Canvas;
+  end;
+  Result:=FRenderer;
+end;
+
 { TFileDescPascalUnitWithFresnelForm }
 
 constructor TFileDescPascalUnitWithFresnelForm.Create;

design/fresneldsgn.lpk

@@ -12,7 +12,7 @@
     </CompilerOptions>
     <Description Value="Lazarus IDE addon for Fresnel forms."/>
     <License Value="Modied LGPL-2"/>
-    <Version Minor="2"/>
+    <Version Minor="3"/>
     <Files>
       <Item>
         <Filename Value="fresnel.register.pas"/>
@@ -26,13 +26,13 @@
     </Files>
     <RequiredPkgs>
       <Item>
-        <PackageName Value="SynEditDsgn"/>
+        <PackageName Value="FresnelLCL"/>
       </Item>
       <Item>
-        <PackageName Value="SynEdit"/>
+        <PackageName Value="SynEditDsgn"/>
       </Item>
       <Item>
-        <PackageName Value="Fresnel"/>
+        <PackageName Value="SynEdit"/>
       </Item>
       <Item>
         <PackageName Value="IDEIntf"/>

src/base/fresnel.app.pas

@@ -0,0 +1,723 @@
+unit Fresnel.App;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, CustApp, Fresnel.Classes, Fresnel.Forms, Fresnel.WidgetSet,
+  LazMethodList, LazLoggerBase;
+
+type
+  TApplicationFlag = (
+    AppWaiting,
+    AppIdleEndSent,
+    AppNoExceptionMessages,
+    AppActive, // application has focus
+    AppDoNotCallAsyncQueue,
+    AppInitialized // initialization of application was done
+    );
+  TApplicationFlags = set of TApplicationFlag;
+
+  TApplicationHandlerType = (
+    ahtIdle,
+    ahtIdleEnd,
+    ahtActivate,
+    ahtDeactivate,
+    ahtMinimize,
+    ahtMaximize,
+    ahtRestore
+  );
+
+  { TApplication }
+
+  TApplication = class(TBaseFresnelApplication)
+  private
+    FApplicationHandlers: array[TApplicationHandlerType] of TMethodList;
+    FCaptureExceptions: Boolean;
+    FComponentsToRelease: TFPList;
+    FComponentsReleasing: TFPList;
+    FCreatingForm: TFresnelForm;
+    FFindGlobalComponentEnabled: Boolean;
+    FMainForm: TFresnelForm;
+    FOldExceptProc: TExceptProc;
+    procedure Activate(Data: Pointer);
+    procedure Deactivate(Data: Pointer);
+    procedure AddHandler(HandlerType: TApplicationHandlerType;
+                         const Handler: TMethod; AsFirst: Boolean);
+    procedure RemoveHandler(HandlerType: TApplicationHandlerType;
+                            const Handler: TMethod);
+    procedure QueuedReleaseComponents(Data: Pointer);
+  protected
+    type
+      PAsyncCallQueueItem = ^TAsyncCallQueueItem;
+      TAsyncCallQueueItem = record
+        Method: TDataEvent;
+        Data: Pointer;
+        NextItem, PrevItem: PAsyncCallQueueItem;
+      end;
+      TAsyncCallQueue = record
+        Top, Last: PAsyncCallQueueItem;
+      end;
+      TAsyncCallQueues = record
+        CritSec: TRTLCriticalSection;
+        Cur: TAsyncCallQueue; // currently processing
+        Next: TAsyncCallQueue; // new calls added to this queue
+      end;
+  protected
+    FFlags: TApplicationFlags;
+    FAsyncCall: TAsyncCallQueues;
+    procedure DoBeforeFinalization; virtual;
+    procedure DoRun; override;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    procedure NotifyActivateHandler; virtual;
+    procedure NotifyDeactivateHandler; virtual;
+    procedure NotifyIdleEndHandler; virtual;
+    procedure NotifyIdleHandler(var Done: Boolean); virtual;
+    procedure WSAppActivate(Async: Boolean = False); virtual;
+    procedure WSAppDeactivate(Async: Boolean = False); virtual;
+    procedure WSAppMinimize; virtual;
+    procedure WSAppMaximize; virtual;
+    procedure WSAppRestore; virtual;
+
+    procedure ProcessAsyncCallQueue; virtual;
+    procedure ReleaseComponents; virtual;
+    procedure SetCaptureExceptions(const AValue: Boolean); virtual;
+    procedure SetFlags(const AValue: TApplicationFlags); virtual;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure CreateGlobal(InstanceClass: TComponentClass; out Reference); virtual; // use this all designed forms and components
+    procedure UpdateMainForm(AForm: TFresnelForm); virtual;
+
+    // events, queues
+    procedure HandleException(Sender: TObject); override;
+    procedure HandleMessage; virtual;
+    procedure ProcessMessages; virtual;
+    procedure Idle(Wait: Boolean); virtual;
+    procedure QueueAsyncCall(const AMethod: TDataEvent; Data: Pointer); override;
+    procedure RemoveAsyncCalls(const AnObject: TObject); override;
+    procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
+    procedure ReleaseComponent(AComponent: TComponent); override;
+
+    property CaptureExceptions: Boolean read FCaptureExceptions write SetCaptureExceptions;
+    property FindGlobalComponentEnabled: Boolean read FFindGlobalComponentEnabled
+                                               write FFindGlobalComponentEnabled;
+    property Flags: TApplicationFlags read FFlags write SetFlags;
+    property MainForm: TFresnelForm read FMainForm;
+    //property MainFormHandle: TFreHandle read GetMainFormHandle;
+  end;
+
+var
+  Application: TApplication;
+
+implementation
+
+var
+  HandlingException: Boolean = False;
+  HaltingProgram: Boolean = False;
+
+procedure ExceptionOccurred(Sender: TObject; Addr: Pointer; FrameCount: Longint;
+  Frames: PPointer);
+Begin
+  DebugLn('[Fresnel.Forms] ExceptionOccurred ');
+  if HaltingProgram or HandlingException then Halt;
+  if Addr=nil then ;
+  if FrameCount=0 then ;
+  if Frames=nil then ;
+
+  HandlingException:=true;
+  if Sender<>nil then
+  begin
+    DebugLn('  Sender=',Sender.ClassName);
+    if Sender is Exception then
+    begin
+      DebugLn('  Exception=',Exception(Sender).Message);
+      DumpExceptionBackTrace();
+    end;
+  end else
+    DebugLn('  Sender=nil');
+  if Application<>nil then
+    Application.HandleException(Sender);
+  HandlingException:=false;
+end;
+
+// Callback function for RegisterFindGlobalComponentProc
+function FindApplicationComponent(const ComponentName: string): TComponent;
+// Note: this function is used by TReader to auto rename forms to unique names.
+begin
+  if Application.FindGlobalComponentEnabled then
+  begin
+    // ignore designer forms (the IDE registers its own functions to handle them)
+    Result:=Application.FindComponent(ComponentName);
+    //if Result=nil then
+    //  Result:=Screen.FindNonDesignerForm(ComponentName);
+    //if Result=nil then
+    //  Result:=Screen.FindNonDesignerDataModule(ComponentName);
+  end
+  else
+    Result:=nil;
+  //debugln('FindApplicationComponent ComponentName="',ComponentName,'" Result=',DbgSName(Result));
+end;
+
+// Callback function for SysUtils.OnGetApplicationName
+function GetApplicationName: string;
+begin
+  if Assigned(Application) then
+    Result := Application.Title
+  else
+    Result := '';
+end;
+
+procedure BeforeFinalization;
+// This is our ExitProc handler.
+begin
+  Application.DoBeforeFinalization;
+end;
+
+{ TApplication }
+
+procedure TApplication.SetCaptureExceptions(const AValue: Boolean);
+begin
+  if FCaptureExceptions=AValue then Exit;
+  FCaptureExceptions:=AValue;
+  if FCaptureExceptions then begin
+    // capture exceptions
+    // store old exceptproc
+    if FOldExceptProc=nil then
+      FOldExceptProc:=ExceptProc;
+    ExceptProc:=@ExceptionOccurred;
+  end else begin
+    // do not capture exceptions
+    if ExceptProc=@ExceptionOccurred then begin
+      // restore old exceptproc
+      ExceptProc:=FOldExceptProc;
+      FOldExceptProc:=nil;
+    end;
+  end;
+end;
+
+procedure TApplication.SetFlags(const AValue: TApplicationFlags);
+begin
+  // Only allow AppNoExceptionMessages to be changed
+  FFlags := Flags - [AppNoExceptionMessages] + AValue*[AppNoExceptionMessages];
+end;
+
+procedure TApplication.Activate(Data: Pointer);
+begin
+  if AppActive in FFlags then exit;
+  Include(FFlags, AppActive);
+  NotifyActivateHandler;
+  if Data=nil then ;
+end;
+
+procedure TApplication.Deactivate(Data: Pointer);
+begin
+  if not (AppActive in FFlags) then exit;
+  Exclude(FFlags, AppActive);
+  NotifyDeactivateHandler;
+  if Data=nil then ;
+end;
+
+procedure TApplication.AddHandler(HandlerType: TApplicationHandlerType;
+  const Handler: TMethod; AsFirst: Boolean);
+begin
+  if Handler.Code=nil then
+    raise Exception.Create('TApplication.AddHandler 20230913180016');
+  if FApplicationHandlers[HandlerType]=nil then
+    FApplicationHandlers[HandlerType]:=TMethodList.Create;
+  FApplicationHandlers[HandlerType].Add(Handler,not AsFirst);
+end;
+
+procedure TApplication.QueuedReleaseComponents(Data: Pointer);
+begin
+  if Data=nil then ;
+  ReleaseComponents;
+end;
+
+procedure TApplication.RemoveHandler(HandlerType: TApplicationHandlerType;
+  const Handler: TMethod);
+begin
+  FApplicationHandlers[HandlerType].Remove(Handler);
+end;
+
+procedure TApplication.DoBeforeFinalization;
+var
+  i: Integer;
+begin
+  if Self=nil then exit;
+  for i := ComponentCount - 1 downto 0 do
+  begin
+    // DebugLn('TApplication.DoBeforeFinalization ',DbgSName(Components[i]));
+    if i < ComponentCount then
+      Components[i].Free;
+  end;
+end;
+
+procedure TApplication.DoRun;
+begin
+  inherited DoRun;
+  if CaptureExceptions then
+    try // run with try..except
+      HandleMessage;
+    except
+      HandleException(Self);
+    end
+  else
+    HandleMessage; // run without try..except
+end;
+
+procedure TApplication.ProcessAsyncCallQueue;
+// Call all methods queued to be called (QueueAsyncCall)
+var
+  lItem: PAsyncCallQueueItem;
+  Event: TDataEvent;
+  Data: Pointer;
+begin
+  with FAsyncCall do begin
+    // move the items of NextQueue to CurQueue, keep the order
+    System.EnterCriticalsection(CritSec);
+    try
+      if Next.Top<>nil then
+      begin
+        if Cur.Last<>nil then
+        begin
+          assert(Cur.Top <> nil, 'TApplication.ProcessAsyncCallQueue: Last entry found, while Top not assigned');
+          Cur.Last^.NextItem:=Next.Top;
+          Next.Top^.PrevItem:=Cur.Last;
+        end else begin
+          assert(Cur.Top = nil, 'TApplication.ProcessAsyncCallQueue: Last entry found, while Top not assigned');
+          Cur.Top:=Next.Top;
+        end;
+        Cur.Last:=Next.Last;
+        Next.Top:=nil;
+        Next.Last:=nil;
+      end;
+    finally
+      System.LeaveCriticalsection(CritSec);
+    end;
+
+    // process items from top to last in 'Cur' queue
+    // this can create new items, which are added to the 'Next' queue
+    // or it can call ProcessAsyncCallQueue, for example via calling
+    // Application.ProcesssMessages
+    // Using a second queue avoids an endless loop, when an event adds a new event.
+    repeat
+      // remove top item from queue
+      System.EnterCriticalSection(CritSec);
+      try
+        if Cur.Top=nil then exit;
+        lItem:=Cur.Top;
+        Cur.Top := lItem^.NextItem;
+        if Cur.Top = nil then
+          Cur.Last := nil
+        else
+          Cur.Top^.PrevItem := nil;
+        // free item
+        Event:=lItem^.Method;
+        Data:=lItem^.Data;
+        Dispose(lItem);
+      finally
+        System.LeaveCriticalSection(CritSec);
+      end;
+      // call event
+      Event(Data);
+    until false;
+  end;
+end;
+
+procedure TApplication.ReleaseComponents;
+var
+  Component: TComponent;
+  IsReferenced: Boolean;
+begin
+  if FComponentsReleasing<>nil then exit; // currently releasing
+  if (FComponentsToRelease<>nil) then begin
+    if FComponentsToRelease.Count=0 then begin
+      FreeAndNil(FComponentsToRelease);
+      exit;
+    end;
+    // free components
+    // Notes:
+    //   - check TLCLComponent.LCLRefCount=0
+    //   - during freeing new components can be added to the FComponentsToRelease
+    //   - components can be removed from FComponentsToRelease and FComponentsReleasing
+    FComponentsReleasing:=FComponentsToRelease;
+    FComponentsToRelease:=nil;
+    try
+      while (FComponentsReleasing<>nil) and (FComponentsReleasing.Count>0) do
+      begin
+        Component:=TComponent(FComponentsReleasing[0]);
+        FComponentsReleasing.Delete(0);
+        IsReferenced:=false; // (Component is TFresnelElement) and (TFresnelElement(Component).RefCount>0);
+        if IsReferenced then
+        begin
+          // add again to FComponentsToRelease
+          ReleaseComponent(Component);
+        end else begin
+          // this might free some more components from FComponentsReleasing
+          Component.Free;
+        end;
+      end;
+    finally
+      // add remaining to FComponentsToRelease
+      while (FComponentsReleasing<>nil) and (FComponentsReleasing.Count>0) do
+      begin
+        Component:=TComponent(FComponentsReleasing[0]);
+        FComponentsReleasing.Delete(0);
+        ReleaseComponent(Component);
+      end;
+      FreeAndNil(FComponentsReleasing);
+    end;
+  end;
+end;
+
+constructor TApplication.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  if Application<>nil then
+    raise Exception.Create('20230908115659');
+  Application:=Self;
+  CustomApplication:=Self;
+
+  System.InitCriticalSection(FAsyncCall.CritSec);
+  RegisterFindGlobalComponentProc(@FindApplicationComponent);
+  OnGetApplicationName := @GetApplicationName;
+
+  CaptureExceptions:=true;
+  AddExitProc(@BeforeFinalization);
+end;
+
+destructor TApplication.Destroy;
+var
+  HandlerType: TApplicationHandlerType;
+begin
+  ProcessAsyncCallQueue;
+  UnregisterFindGlobalComponentProc(@FindApplicationComponent);
+
+  for HandlerType:=Low(TApplicationHandlerType) to High(TApplicationHandlerType) do
+    FreeAndNil(FApplicationHandlers[HandlerType]);
+
+  inherited Destroy;
+
+  Include(FFlags,AppDoNotCallAsyncQueue);
+  ProcessAsyncCallQueue;
+  System.DoneCriticalSection(FAsyncCall.CritSec);
+
+  // restore exception handling
+  CaptureExceptions:=false;
+  OnGetApplicationName := nil;
+
+  Application:=nil;
+  CustomApplication:=nil;
+end;
+
+procedure TApplication.CreateGlobal(InstanceClass: TComponentClass; out
+  Reference);
+var
+  Instance: TComponent;
+  ok: boolean;
+  AForm: TFresnelForm;
+begin
+  // Allocate the instance, without calling the constructor
+  Instance := TComponent(InstanceClass.NewInstance);
+  // set the Reference before the constructor is called, so that
+  // events and constructors can refer to it
+  TComponent(Reference) := Instance;
+
+  if Instance is TFresnelForm then
+    AForm := TFresnelForm(Instance)
+  else
+    AForm:=nil;
+
+  ok:=false;
+  try
+    if (FCreatingForm=nil) and (AForm<>nil) then
+      FCreatingForm:=AForm;
+    Instance.Create(Self);
+
+    if AForm<>nil then
+    begin
+      UpdateMainForm(AForm);
+      if FMainForm = AForm then
+        AForm.CreateWSForm;
+      if AForm.FormStyle = fsSplash then
+      begin
+        // show the splash form and handle the paint message
+        AForm.Show;
+        AForm.Invalidate;
+        ProcessMessages;
+      end;
+    end;
+
+    ok:=true;
+  finally
+    if not ok then begin
+      TComponent(Reference) := nil;
+    end;
+    if FCreatingForm=Instance then
+      FCreatingForm:=nil;
+  end;
+end;
+
+procedure TApplication.UpdateMainForm(AForm: TFresnelForm);
+begin
+  if (FMainForm = nil)
+  and (FCreatingForm=AForm)
+  and (not (csDestroying in ComponentState))
+  and not (AForm.FormStyle in [fsSplash])
+  then
+    FMainForm := AForm;
+end;
+
+procedure TApplication.HandleException(Sender: TObject);
+begin
+  // todo
+  inherited HandleException(Sender);
+end;
+
+procedure TApplication.HandleMessage;
+var
+  Context: TFreHandle;
+begin
+  Context := WidgetSet.BeginMessageProcess;
+  try
+    WidgetSet.AppProcessMessages; // process all events
+    if not Terminated then Idle(true);
+  finally
+    WidgetSet.EndMessageProcess(Context);
+  end;
+end;
+
+procedure TApplication.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if Operation=opRemove then
+  begin
+    if FComponentsToRelease<>nil then
+      FComponentsToRelease.Remove(AComponent);
+    if FComponentsReleasing<>nil then
+      FComponentsReleasing.Remove(AComponent);
+    if AComponent = MainForm then begin
+      FMainForm:= nil;
+      Terminate;
+    end;
+  end;
+end;
+
+procedure TApplication.NotifyActivateHandler;
+begin
+  FApplicationHandlers[ahtActivate].CallNotifyEvents(Self);
+end;
+
+procedure TApplication.NotifyDeactivateHandler;
+begin
+  FApplicationHandlers[ahtDeactivate].CallNotifyEvents(Self);
+end;
+
+procedure TApplication.NotifyIdleEndHandler;
+begin
+  FApplicationHandlers[ahtIdleEnd].CallNotifyEvents(Self);
+end;
+
+procedure TApplication.NotifyIdleHandler(var Done: Boolean);
+var
+  i: LongInt;
+begin
+  i:=FApplicationHandlers[ahtIdle].Count;
+  while FApplicationHandlers[ahtIdle].NextDownIndex(i) do begin
+    TIdleEvent(FApplicationHandlers[ahtIdle][i])(Self,Done);
+    if not Done then exit;
+  end;
+end;
+
+procedure TApplication.ProcessMessages;
+var
+  Context: TFreHandle;
+begin
+  if Self=nil then begin
+    // when the programmer did a mistake, avoid getting strange errors
+    raise Exception.Create('Application=nil');
+  end;
+  Context := WidgetSet.BeginMessageProcess;
+  try
+    WidgetSet.AppProcessMessages;
+    if not Terminated then
+      ProcessAsyncCallQueue;
+  finally
+    WidgetSet.EndMessageProcess(Context);
+  end;
+end;
+
+procedure TApplication.Idle(Wait: Boolean);
+var
+  Done: Boolean;
+begin
+  ReleaseComponents;
+  ProcessAsyncCallQueue;
+
+  Done := True;
+  //if (FIdleLockCount=0) then begin
+  //  if Assigned(FOnIdle) then FOnIdle(Self, Done);
+  //  if Done then
+  //    NotifyIdleHandler(Done);
+  //end;
+  if Done
+  then begin
+    // wait till something happens
+    //if (FIdleLockCount=0) then
+    //  DoIdleActions;
+    Include(FFlags,AppWaiting);
+    Exclude(FFlags,AppIdleEndSent);
+    if Wait then
+      WidgetSet.AppWaitMessage;
+    //if (FIdleLockCount=0) then
+    //  DoOnIdleEnd;
+    Exclude(FFlags,AppWaiting);
+  end;
+end;
+
+procedure TApplication.WSAppActivate(Async: Boolean);
+begin
+  if Async then
+    QueueAsyncCall(@Activate, Self)
+  else
+    Activate(Self);
+end;
+
+procedure TApplication.WSAppDeactivate(Async: Boolean);
+begin
+  if Async then
+    QueueAsyncCall(@Deactivate, Self)
+  else
+    Deactivate(Self);
+end;
+
+procedure TApplication.WSAppMinimize;
+begin
+  FApplicationHandlers[ahtMinimize].CallNotifyEvents(Self);
+end;
+
+procedure TApplication.WSAppMaximize;
+begin
+  FApplicationHandlers[ahtMaximize].CallNotifyEvents(Self);
+end;
+
+procedure TApplication.WSAppRestore;
+begin
+  //Screen.RestoreLastActive;
+  FApplicationHandlers[ahtRestore].CallNotifyEvents(Self);
+end;
+
+procedure TApplication.QueueAsyncCall(const AMethod: TDataEvent; Data: Pointer);
+var
+  lItem: PAsyncCallQueueItem;
+begin
+  if AppDoNotCallAsyncQueue in FFlags then
+    raise Exception.Create('TApplication.QueueAsyncCall already shut down');
+  New(lItem);
+  lItem^.Method := AMethod;
+  lItem^.Data := Data;
+  lItem^.NextItem := nil;
+  System.EnterCriticalsection(FAsyncCall.CritSec);
+  try
+    with FAsyncCall.Next do begin
+      lItem^.PrevItem := Last;
+      if Last<>nil then begin
+        assert(Top <> nil, 'TApplication.QueueAsyncCall: Top entry missing (but last is assigned)');
+        Last^.NextItem := lItem
+      end else begin
+        assert(Last = nil, 'TApplication.QueueAsyncCall: Last entry found, while Top not assigned');
+        Top := lItem;
+      end;
+      Last := lItem;
+    end;
+  finally
+    System.LeaveCriticalsection(FAsyncCall.CritSec);
+  end;
+
+  if Assigned(WakeMainThread) then
+    WakeMainThread(nil);
+end;
+
+procedure TApplication.RemoveAsyncCalls(const AnObject: TObject);
+
+  procedure DoRemoveAsyncCalls(var AQueue: TAsyncCallQueue);
+  var
+    lItem, lItem2: PAsyncCallQueueItem;
+  begin
+    lItem := AQueue.Last;
+    while lItem <> nil do begin
+      if TMethod(lItem^.Method).Data = Pointer(AnObject) then begin
+        if lItem^.NextItem <> nil then
+          lItem^.NextItem^.PrevItem := lItem^.PrevItem;
+        if lItem^.PrevItem <> nil then
+          lItem^.PrevItem^.NextItem := lItem^.NextItem;
+
+        if lItem = AQueue.Last then
+          AQueue.Last := lItem^.PrevItem;
+        if lItem = AQueue.Top then
+          AQueue.Top := lItem^.NextItem;
+
+        lItem2 := lItem;
+        lItem := lItem^.PrevItem;
+        Dispose(lItem2);
+      end
+      else
+        lItem := lItem^.PrevItem;
+    end;
+  end;
+
+begin
+  if AppDoNotCallAsyncQueue in FFlags then
+    raise Exception.Create('TApplication.QueueAsyncCall already shut down');
+
+  System.EnterCriticalsection(FAsyncCall.CritSec);
+  try
+    DoRemoveAsyncCalls(FAsyncCall.Cur);
+    DoRemoveAsyncCalls(FAsyncCall.Next);
+  finally
+    System.LeaveCriticalSection(FAsyncCall.CritSec);
+  end;
+end;
+
+procedure TApplication.RemoveAllHandlersOfObject(AnObject: TObject);
+var
+  HandlerType: TApplicationHandlerType;
+begin
+  for HandlerType:=Low(TApplicationHandlerType) to High(TApplicationHandlerType) do
+    FApplicationHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject);
+end;
+
+procedure TApplication.ReleaseComponent(AComponent: TComponent);
+var
+  IsFirstItem, IsReferenced: Boolean;
+begin
+  if csDestroying in AComponent.ComponentState then exit;
+  //DebugLn(['TApplication.ReleaseComponent ',DbgSName(AComponent)]);
+  if csDesigning in ComponentState then begin
+    // free immediately
+    AComponent.Free;
+  end else begin
+    // free later
+    // => add to the FComponentsToRelease
+    IsFirstItem:=FComponentsToRelease=nil;
+    if IsFirstItem then
+      FComponentsToRelease:=TFPList.Create
+    else if FComponentsToRelease.IndexOf(AComponent)>=0 then
+      exit;
+    FComponentsToRelease.Add(AComponent);
+    AComponent.FreeNotification(Self);
+    if IsFirstItem then begin
+      IsReferenced:=false;
+      if IsReferenced then
+        //OnDecLCLRefcountToZero := @DoDecLCLRefcountToZero
+      else
+        QueueAsyncCall(@QueuedReleaseComponents, nil);
+    end;
+  end;
+end;
+
+end.
+

src/base/fresnel.classes.pas

@@ -0,0 +1,518 @@
+unit Fresnel.Classes;
+
+{$mode objfpc}{$H+}
+{$WARN 6060 off} // Case statement does not handle all possible cases
+{$ModeSwitch AdvancedRecords}
+
+interface
+
+uses
+  Classes, SysUtils, Math, Types;
+
+type
+
+  { EFresnel }
+
+  EFresnel = class(Exception)
+  end;
+
+  TFresnelLength = double;
+  TArray4FresnelLength =  array[0..3] of TFresnelLength;
+
+const
+  MaxFresnelLength = TFresnelLength(high(longint));
+
+type
+  TFresnelCaption = type string;
+
+  { TFresnelPoint }
+
+  TFresnelPoint = packed record
+    X, Y: TFresnelLength;
+    constructor Create(const aX, aY: TFresnelLength); overload;
+    constructor Create(const aPoint: TPoint); overload;
+    class function PointInCircle(const aPoint, aCenter: TFresnelPoint; const aRadius: TFresnelLength): Boolean; static; inline;
+    class function Zero: TFresnelPoint; static; inline;
+    class operator + (const p1, p2: TFresnelPoint): TFresnelPoint;
+    class operator - (const p1, p2: TFresnelPoint): TFresnelPoint;
+    class operator <> (const p1, p2: TFresnelPoint): Boolean;
+    class operator = (const p1, p2: TFresnelPoint): Boolean;
+    function Add(const p: TFresnelPoint): TFresnelPoint;
+    function Angle(const p: TFresnelPoint): TFresnelLength;
+    function Distance(const p: TFresnelPoint): TFresnelLength;
+    function IsZero: Boolean;
+    function Subtract(const p: TFresnelPoint): TFresnelPoint;
+    procedure Offset(const dx,dy: TFresnelLength);
+    procedure Offset(const p: TFresnelPoint);
+    procedure SetLocation(const ax, ay: TFresnelLength); overload;
+    procedure SetLocation(const p: TFresnelPoint); overload;
+    procedure SetLocation(const p: TPoint); overload;
+    function GetPoint: TPoint;
+  end;
+  TFresnelPointDynArray = array of TFresnelPoint;
+
+  { TFresnelRect }
+
+  TFresnelRect = packed record
+  private
+    function GetHeight: TFresnelLength;
+    function GetSize: TFresnelPoint;
+    function GetWidth: TFresnelLength;
+    procedure SetHeight(const AValue: TFresnelLength);
+    procedure SetSize(const AValue: TFresnelPoint);
+    procedure SetWidth(const AValue: TFresnelLength);
+  public
+    procedure Clear;
+    constructor Create(const ALeft, ATop, ARight, ABottom: TFresnelLength); overload;
+    constructor Create(const aRect: TRect); overload;
+    class operator = (const L, R: TFresnelRect): Boolean;
+    class operator <> (const L, R: TFresnelRect): Boolean;
+    class operator + (const L, R: TFresnelRect): TFresnelRect; // union
+    class operator * (const L, R: TFresnelRect): TFresnelRect; // intersection
+    class function Empty: TFresnelRect; static;
+    procedure NormalizeRect;
+    function IsEmpty: Boolean;
+    function Contains(const P: TFresnelPoint): Boolean;
+    function Contains(const R: TFresnelRect): Boolean;
+    function Contains(const ax, ay: TFresnelLength): Boolean;
+    function IntersectsWith(const R: TFresnelRect): Boolean;
+    class function Intersect(const R1, R2: TFresnelRect): TFresnelRect; static;
+    procedure Intersect(const R: TFresnelRect);
+    class function Union(const R1, R2: TFresnelRect): TFresnelRect; static;
+    procedure Union(const R: TFresnelRect);
+    class function Union(const Points: TFresnelPointDynArray): TFresnelRect; static;
+    procedure Offset(const DX, DY: TFresnelLength);
+    procedure Offset(const DP: TFresnelPoint);
+    procedure SetLocation(const X, Y: TFresnelLength);
+    procedure SetLocation(const P: TFresnelPoint);
+    procedure Inflate(const DX, DY: TFresnelLength);
+    procedure Inflate(const DL, DT, DR, DB: TFresnelLength);
+    function CenterPoint: TFresnelPoint;
+    function GetRectF: TRectF;
+    procedure SetRectF(const r: TRectF);
+    function GetRect: TRect;
+    procedure SetRect(const r: TRect);
+  public
+    property Height: TFresnelLength read GetHeight write SetHeight;
+    property Width: TFresnelLength read GetWidth write SetWidth;
+    property Size: TFresnelPoint read GetSize write SetSize;
+    case Longint of
+      0: (Left, Top, Right, Bottom: TFresnelLength);
+      1: (TopLeft, BottomRight: TFresnelPoint);
+      2: (Vector: TArray4FresnelLength);
+  end;
+  TFresnelRectDynArray = array of TFresnelRect;
+
+  { TFresnelComponent }
+
+  TFresnelComponent = class(TComponent)
+  end;
+
+implementation
+
+{ TFresnelPoint }
+
+class function TFresnelPoint.Zero: TFresnelPoint;
+begin
+  Result.x := 0.0;
+  Result.y := 0.0;
+end;
+
+function TFresnelPoint.Add(const p: TFresnelPoint): TFresnelPoint;
+begin
+  Result.x := X+p.X;
+  Result.y := Y+p.Y;
+end;
+
+function TFresnelPoint.Distance(const p: TFresnelPoint): TFresnelLength;
+begin
+  Result := Sqrt(Sqr(p.X-X)+Sqr(p.Y-Y));
+end;
+
+function TFresnelPoint.IsZero: Boolean;
+begin
+  Result:=SameValue(X,0) and SameValue(y,0);
+end;
+
+function TFresnelPoint.Subtract(const p: TFresnelPoint): TFresnelPoint;
+begin
+  Result.x := X-p.X;
+  Result.y := Y-p.Y;
+end;
+
+procedure TFresnelPoint.SetLocation(const p: TFresnelPoint);
+begin
+  X:=p.X;
+  Y:=p.Y;
+end;
+
+procedure TFresnelPoint.SetLocation(const p: TPoint);
+begin
+  X:=p.X;
+  Y:=p.Y;
+end;
+
+function TFresnelPoint.GetPoint: TPoint;
+begin
+  Result.X:=round(X);
+  Result.Y:=round(Y);
+end;
+
+procedure TFresnelPoint.SetLocation(const ax, ay: TFresnelLength);
+begin
+  X:=ax;
+  Y:=ay;
+end;
+
+procedure TFresnelPoint.Offset(const p: TFresnelPoint);
+begin
+  X:=X+p.X;
+  Y:=Y+p.Y;
+end;
+
+procedure TFresnelPoint.Offset(const dx, dy: TFresnelLength);
+begin
+  X:=X+dX;
+  Y:=Y+dY;
+end;
+
+function TFresnelPoint.Angle(const p: TFresnelPoint): TFresnelLength;
+
+  function ArcTan2(const y,x: TFresnelLength): TFresnelLength;
+    begin
+      if x=0 then
+        begin
+          if y=0 then
+            Result:=0.0
+          else if y>0 then
+            Result:=pi/2
+          else
+            Result:=-pi/2;
+        end
+      else
+        begin
+          Result:=ArcTan(y/x);
+          if x<0 then
+            if y<0 then
+              Result:=Result-pi
+            else
+              Result:=Result+pi;
+        end;
+    end;
+
+begin
+  Result:=ArcTan2(Y-p.Y,X-p.X);
+end;
+
+constructor TFresnelPoint.Create(const aX, aY: TFresnelLength);
+begin
+  X:=aX;
+  Y:=aY;
+end;
+
+constructor TFresnelPoint.Create(const aPoint: TPoint);
+begin
+  X:=aPoint.X;
+  Y:=aPoint.Y;
+end;
+
+class function TFresnelPoint.PointInCircle(const aPoint,
+  aCenter: TFresnelPoint; const aRadius: TFresnelLength): Boolean;
+begin
+  Result := aPoint.Distance(aCenter) <= aRadius;
+end;
+
+class operator TFresnelPoint.=(const p1, p2: TFresnelPoint): Boolean;
+begin
+  Result:=SameValue(p1.X,p2.X) and SameValue(p1.Y,p2.Y);
+end;
+
+class operator TFresnelPoint.<>(const p1, p2: TFresnelPoint): Boolean;
+begin
+  Result:=(not SameValue(p1.X,p2.X)) or (not SameValue(p1.Y,p2.Y));
+end;
+
+class operator TFresnelPoint.+(const p1, p2: TFresnelPoint): TFresnelPoint;
+begin
+  Result.X:=p1.X+p2.X;
+  Result.Y:=p1.Y+p2.Y;
+end;
+
+class operator TFresnelPoint.-(const p1, p2: TFresnelPoint): TFresnelPoint;
+begin
+  Result.X:=p1.X-p2.X;
+  Result.Y:=p1.Y-p2.Y;
+end;
+
+{ TFresnelRect }
+
+procedure TFresnelRect.Clear;
+begin
+  Left:=0.0;
+  Top:=0.0;
+  Right:=0.0;
+  Bottom:=0.0;
+end;
+
+constructor TFresnelRect.Create(const ALeft, ATop, ARight,
+  ABottom: TFresnelLength);
+begin
+  Left := ALeft;
+  Top := ATop;
+  Right := ARight;
+  Bottom := ABottom;
+end;
+
+constructor TFresnelRect.Create(const aRect: TRect);
+begin
+  Left:=aRect.Left;
+  Top:=aRect.Top;
+  Right:=aRect.Right;
+  Bottom:=aRect.Bottom;
+end;
+
+class operator TFresnelRect.=(const L, R: TFresnelRect): Boolean;
+begin
+  Result := SameValue(L.Left,R.Left) and SameValue(L.Right,R.Right)
+        and SameValue(L.Top,R.Top) and SameValue(L.Bottom,R.Bottom);
+end;
+
+class operator TFresnelRect.<>(const L, R: TFresnelRect): Boolean;
+begin
+  Result := (not SameValue(L.Left,R.Left)) and (not SameValue(L.Right,R.Right))
+        and (not SameValue(L.Top,R.Top)) and (not SameValue(L.Bottom,R.Bottom));
+end;
+
+class operator TFresnelRect.+(const L, R: TFresnelRect): TFresnelRect;
+begin
+  Result := TFresnelRect.Union(L, R);
+end;
+
+class operator TFresnelRect.*(const L, R: TFresnelRect): TFresnelRect;
+begin
+  Result := TFresnelRect.Intersect(L, R);
+end;
+
+class function TFresnelRect.Empty: TFresnelRect;
+begin
+  Result := TFresnelRect.Create(0,0,0,0);
+end;
+
+procedure TFresnelRect.NormalizeRect;
+var
+  h: TFresnelLength;
+begin
+  if Top>Bottom then
+  begin
+    h := Top;
+    Top := Bottom;
+    Bottom := h;
+  end;
+  if Left>Right then
+  begin
+    h := Left;
+    Left := Right;
+    Right := h;
+  end
+end;
+
+function TFresnelRect.IsEmpty: Boolean;
+begin
+  Result := (Right <= Left) or (Bottom <= Top);
+end;
+
+function TFresnelRect.Contains(const P: TFresnelPoint): Boolean;
+begin
+  Result := (Left <= P.X) and (P.X < Right) and (Top <= P.Y) and (P.Y < Bottom);
+end;
+
+function TFresnelRect.Contains(const R: TFresnelRect): Boolean;
+begin
+  Result := (Left <= R.Left) and (R.Right <= Right) and (Top <= R.Top) and (R.Bottom <= Bottom);
+end;
+
+function TFresnelRect.Contains(const ax, ay: TFresnelLength): Boolean;
+begin
+  Result := (Left <= ax) and (ax < Right) and (Top <= ay) and (ay < Bottom);
+end;
+
+function TFresnelRect.IntersectsWith(const R: TFresnelRect): Boolean;
+begin
+  Result := (Left < R.Right) and (R.Left < Right) and (Top < R.Bottom) and (R.Top < Bottom);
+end;
+
+class function TFresnelRect.Intersect(const R1, R2: TFresnelRect): TFresnelRect;
+begin
+  Result.Left:=Max(R1.Left,R2.Left);
+  Result.Right:=Min(R1.Right,R2.Right);
+  Result.Top:=Max(R1.Top,R2.Top);
+  Result.Bottom:=Min(R1.Bottom,R2.Bottom);
+  if Result.IsEmpty then
+    FillByte(Result,SizeOf(TFresnelRect),0);
+end;
+
+procedure TFresnelRect.Intersect(const R: TFresnelRect);
+begin
+  if Left<R.Left then Left:=R.Left;
+  if Right>R.Right then Right:=R.Right;
+  if Top<R.Top then Top:=R.Top;
+  if Bottom>R.Bottom then Bottom:=R.Bottom;
+  if IsEmpty then
+    FillByte(Self,SizeOf(TFresnelRect),0);
+end;
+
+class function TFresnelRect.Union(const R1, R2: TFresnelRect): TFresnelRect;
+begin
+  Result.Left:=Min(R1.Left,R2.Left);
+  Result.Right:=Max(R1.Right,R2.Right);
+  Result.Top:=Min(R1.Top,R2.Top);
+  Result.Bottom:=Max(R1.Bottom,R2.Bottom);
+  if Result.IsEmpty then
+    FillByte(Result,SizeOf(TFresnelRect),0);
+end;
+
+procedure TFresnelRect.Union(const R: TFresnelRect);
+begin
+  if Left>R.Left then Left:=R.Left;
+  if Right<R.Right then Right:=R.Right;
+  if Top>R.Top then Top:=R.Top;
+  if Bottom<R.Bottom then Bottom:=R.Bottom;
+  if IsEmpty then
+    FillByte(Self,SizeOf(TFresnelRect),0);
+end;
+
+class function TFresnelRect.Union(const Points: TFresnelPointDynArray
+  ): TFresnelRect;
+var
+  i: Integer;
+begin
+  if Length(Points) > 0 then
+  begin
+    Result.TopLeft := Points[Low(Points)];
+    Result.BottomRight := Points[Low(Points)];
+
+    for i := Low(Points)+1 to High(Points) do
+    begin
+      if Points[i].X < Result.Left then Result.Left := Points[i].X;
+      if Points[i].X > Result.Right then Result.Right := Points[i].X;
+      if Points[i].Y < Result.Top then Result.Top := Points[i].Y;
+      if Points[i].Y > Result.Bottom then Result.Bottom := Points[i].Y;
+    end;
+  end else
+    Result := Empty;
+end;
+
+procedure TFresnelRect.Offset(const DX, DY: TFresnelLength);
+begin
+  Left:=Left+DX;
+  Top:=Top+DY;
+  Right:=Right+DX;
+  Bottom:=Bottom+DY;
+end;
+
+procedure TFresnelRect.Offset(const DP: TFresnelPoint);
+begin
+  Left:=Left+DP.X;
+  Top:=Top+DP.Y;
+  Right:=Right+DP.X;
+  Bottom:=Bottom+DP.Y;
+end;
+
+procedure TFresnelRect.SetLocation(const X, Y: TFresnelLength);
+begin
+  Offset(X-Left, Y-Top);
+end;
+
+procedure TFresnelRect.SetLocation(const P: TFresnelPoint);
+begin
+  Offset(P.X-Left, P.Y-Top);
+end;
+
+procedure TFresnelRect.Inflate(const DX, DY: TFresnelLength);
+begin
+  Left:=Left-DX;
+  Top:=Top-DY;
+  Right:=Right+DX;
+  Bottom:=Bottom+DY;
+end;
+
+procedure TFresnelRect.Inflate(const DL, DT, DR, DB: TFresnelLength);
+begin
+  Left:=Left-DL;
+  Top:=Top-DT;
+  Right:=Right+DR;
+  Bottom:=Bottom+DB;
+end;
+
+function TFresnelRect.CenterPoint: TFresnelPoint;
+begin
+  Result.X := (Left+Right)/2;
+  Result.Y := (Top+Bottom)/2;
+end;
+
+function TFresnelRect.GetRectF: TRectF;
+begin
+  Result.Left:=Left;
+  Result.Top:=Top;
+  Result.Right:=Right;
+  Result.Bottom:=Bottom;
+end;
+
+procedure TFresnelRect.SetRectF(const r: TRectF);
+begin
+  Left:=r.Left;
+  Top:=r.Top;
+  Right:=r.Right;
+  Bottom:=r.Bottom;
+end;
+
+function TFresnelRect.GetRect: TRect;
+begin
+  Result.Left:=round(Left);
+  Result.Top:=round(Top);
+  Result.Right:=round(Right);
+  Result.Bottom:=round(Bottom);
+end;
+
+procedure TFresnelRect.SetRect(const r: TRect);
+begin
+  Left:=r.Left;
+  Top:=r.Top;
+  Right:=r.Right;
+  Bottom:=r.Bottom;
+end;
+
+function TFresnelRect.GetHeight: TFresnelLength;
+begin
+  Result:=Bottom-Top;
+end;
+
+function TFresnelRect.GetSize: TFresnelPoint;
+begin
+  Result.X:=Right-Left;
+  Result.Y:=Bottom-Top;
+end;
+
+function TFresnelRect.GetWidth: TFresnelLength;
+begin
+  Result:=Right-Left;
+end;
+
+procedure TFresnelRect.SetHeight(const AValue: TFresnelLength);
+begin
+  Bottom:=Top+AValue;
+end;
+
+procedure TFresnelRect.SetSize(const AValue: TFresnelPoint);
+begin
+  Right:=Left+AValue.X;
+  Bottom:=Top+AValue.Y;
+end;
+
+procedure TFresnelRect.SetWidth(const AValue: TFresnelLength);
+begin
+  Right:=Left+AValue;
+end;
+
+end.
+

src/fresnel.controls.pas → src/base/fresnel.controls.pas

@@ -8,8 +8,9 @@ unit Fresnel.Controls;
 interface
 
 uses
-  Classes, SysUtils, Math, Fresnel.Dom, LazLoggerBase, fpCSSResolver,
-  fpCSSTree;
+  Classes, SysUtils, Math, fpCSSResolver, fpCSSTree,
+  LazLoggerBase,
+  Fresnel.Classes, Fresnel.Dom;
 
 type
 
@@ -105,8 +106,7 @@ type
   public
     class function CSSTypeID: TCSSNumericalID; override;
     class function CSSTypeName: TCSSString; override;
-    function GetCSSInitialAttribute(const AttrID: TCSSNumericalID): TCSSString;
-      override;
+    function GetCSSInitialAttribute(const AttrID: TCSSNumericalID): TCSSString; override;
     procedure ClearCSSValues; override;
   end;
 
@@ -262,6 +262,8 @@ begin
     exit('');
   Attr:=TFresnelCSSAttribute(AttrID-FresnelElementBaseAttrID);
   case Attr of
+  fcaBackgroundColor: Result:='white';
+  fcaColor: Result:='black';
   fcaDisplayOutside: Result:='block';
   fcaPosition: Result:='absolute';
   else

src/fresnel.dom.pas → src/base/fresnel.dom.pas

@@ -7,6 +7,7 @@
  *****************************************************************************
 
 ToDo:
+- TFresnelFontEngine.DeAllocate
 - speed up GetCSSIndex
 - speed up GetCSSDepth
 - speed up GetCSSNextOfType
@@ -26,73 +27,11 @@ interface
 
 uses
   Classes, SysUtils, Math, Types, FPImage, sortbase,
-  fpCSSResolver, fpCSSTree, fpCSSParser, fcl.events, fresnel.events,
-  LazLoggerBase;
+  fpCSSResolver, fpCSSTree, fpCSSParser, FCL.Events,
+  LazLoggerBase,
+  Fresnel.Classes, Fresnel.Events;
 
 type
-  { EFresnel }
-
-  EFresnel = class(Exception)
-  end;
-
-  TFresnelLength = double;
-  TArray4FresnelLength =  array[0..3] of TFresnelLength;
-
-  { TFresnelPoint }
-
-  TFresnelPoint = packed record
-    X, Y: TFresnelLength;
-    class function PointInCircle(const aPoint, aCenter: TFresnelPoint; const aRadius: TFresnelLength): Boolean; static; inline;
-    class function Zero: TFresnelPoint; static; inline;
-    class operator + (const p1, p2: TFresnelPoint): TFresnelPoint;
-    class operator - (const p1, p2: TFresnelPoint): TFresnelPoint;
-    class operator <> (const p1, p2: TFresnelPoint): Boolean;
-    class operator = (const p1, p2: TFresnelPoint): Boolean;
-    function Add(const p: TFresnelPoint): TFresnelPoint;
-    function Angle(const p: TFresnelPoint): TFresnelLength;
-    function Distance(const p: TFresnelPoint): TFresnelLength;
-    function IsZero: Boolean;
-    function Subtract(const p: TFresnelPoint): TFresnelPoint;
-    procedure Offset(const dx,dy: TFresnelLength);
-    procedure Offset(const p: TFresnelPoint);
-    procedure SetLocation(const ax, ay: TFresnelLength);
-    procedure SetLocation(const p: TFresnelPoint);
-  end;
-
-  { TFresnelRect }
-
-  TFresnelRect = packed record
-    procedure Clear;
-    constructor Create(const ALeft, ATop, ARight, ABottom: TFresnelLength);
-    class operator = (const L, R: TFresnelRect): Boolean;
-    class operator <> (const L, R: TFresnelRect): Boolean;
-    class operator + (const L, R: TFresnelRect): TFresnelRect; // union
-    class operator * (const L, R: TFresnelRect): TFresnelRect; // intersection
-    class function Empty: TFresnelRect; static;
-    procedure NormalizeRect;
-    function IsEmpty: Boolean;
-    function Contains(const P: TFresnelPoint): Boolean;
-    function Contains(const R: TFresnelRect): Boolean;
-    function Contains(const ax, ay: TFresnelLength): Boolean;
-    function IntersectsWith(const R: TFresnelRect): Boolean;
-    class function Intersect(const R1, R2: TFresnelRect): TFresnelRect; static;
-    procedure Intersect(const R: TFresnelRect);
-    class function Union(const R1, R2: TFresnelRect): TFresnelRect; static;
-    procedure Union(const R: TFresnelRect);
-    class function Union(const Points: array of TFresnelPoint): TFresnelRect; static;
-    procedure Offset(const DX, DY: TFresnelLength);
-    procedure Offset(const DP: TFresnelPoint);
-    procedure SetLocation(const X, Y: TFresnelLength);
-    procedure SetLocation(const P: TFresnelPoint);
-    procedure Inflate(const DX, DY: TFresnelLength);
-    procedure Inflate(const DL, DT, DR, DB: TFresnelLength);
-    function CenterPoint: TFresnelPoint;
-  public
-    case Longint of
-      0: (Left, Top, Right, Bottom: TFresnelLength);
-      1: (TopLeft, BottomRight: TFresnelPoint);
-      2: (Vector: TArray4FresnelLength);
-  end;
 
   { EFresnelFont }
 
@@ -100,7 +39,6 @@ type
   end;
 
 const
-  MaxFresnelLength = TFresnelLength(high(longint));
   FresnelDefaultDPI = 96;
 
 type
@@ -302,6 +240,7 @@ type
 
   TFresnelLayouter = class(TComponent)
   public
+    procedure Apply(aViewport: TFresnelViewport); virtual; abstract;
     procedure ComputeCSS(El: TFresnelElement); virtual; abstract;
     procedure ComputedChildrenCSS(El: TFresnelElement); virtual; abstract;
   end;
@@ -339,7 +278,7 @@ type
 
   { TFresnelElement }
 
-  TFresnelElement = class(TComponent, ICSSNode, IFPObserver)
+  TFresnelElement = class(TFresnelComponent, ICSSNode, IFPObserver)
   private
     function GetCSSPseudo(Pseudo: TFresnelCSSPseudo): string;
     function GetNodeCount: integer;
@@ -360,7 +299,7 @@ type
     FRenderedBorderBox: TFresnelRect;
     FRenderedContentBox: TFresnelRect;
     // Todo: change to dictionary to reduce mem footprint
-    FStandardEvents : Array[0..MaxFresnelEvents] of TEventHandlerItem;
+    FStandardEvents : Array[0..evtLastEvent] of TEventHandlerItem;
     FEventDispatcher : TFresnelEventDispatcher;
     function GetEventHandler(AIndex: Integer): TFresnelEventHandler;
     procedure SetEventHandler(AIndex: Integer; AValue: TFresnelEventHandler);
@@ -548,7 +487,9 @@ type
 
   TFresnelFontEngine = class(TComponent)
   public
+    class var WSEngine: TFresnelFontEngine;
     function Allocate(const Desc: TFresnelFontDesc): IFresnelFont; virtual; abstract;
+    // ToDo DeAllocate
   end;
 
   { TFresnelViewport }
@@ -657,8 +598,9 @@ function CompareFresnelRect(const A, B: TFresnelRect): integer;
 function FPColorToCSS(const c: TFPColor): string;
 function CSSToFPColor(const s: string; out c: TFPColor): boolean;
 
-function dbgs(const p: TFresnelPoint): string;
-function dbgs(const r: TFresnelRect): string;
+function dbgs(const p: TFresnelPoint): string; overload;
+function dbgs(const r: TFresnelRect): string; overload;
+function dbgs(const c: TFPColor): string; overload;
 
 implementation
 
@@ -880,6 +822,20 @@ begin
   Result:=FloatToStr(r.Left)+','+FloatToStr(r.Top)+','+FloatToStr(r.Right)+','+FloatToStr(r.Bottom);
 end;
 
+function dbgs(const c: TFPColor): string;
+
+  function IsByte(w: word): boolean;
+  begin
+    Result:=lo(w)=hi(w);
+  end;
+
+begin
+  if IsByte(c.Alpha) and IsByte(c.Red) and IsByte(c.Green) and IsByte(c.Blue) then
+    Result:='$'+HexStr(c.Alpha shr 8,2)+HexStr(c.Red shr 8,2)+HexStr(c.Green shr 8,2)+HexStr(c.Blue shr 8,2)
+  else
+    Result:='$A'+HexStr(c.Alpha,4)+'R'+HexStr(c.Red,4)+'G'+HexStr(c.Green,4)+'B'+HexStr(c.Blue,4);
+end;
+
 { TFresnelLayoutNode }
 
 procedure TFresnelLayoutNode.SetElement(const AValue: TFresnelElement);
@@ -951,314 +907,6 @@ begin
   FNodes.Sort(Compare,Context,SortBase.DefaultSortingAlgorithm);
 end;
 
-{ TFresnelPoint }
-
-class function TFresnelPoint.Zero: TFresnelPoint;
-begin
-  Result.x := 0.0;
-  Result.y := 0.0;
-end;
-
-function TFresnelPoint.Add(const p: TFresnelPoint): TFresnelPoint;
-begin
-  Result.x := X+p.X;
-  Result.y := Y+p.Y;
-end;
-
-function TFresnelPoint.Distance(const p: TFresnelPoint): TFresnelLength;
-begin
-  Result := Sqrt(Sqr(p.X-X)+Sqr(p.Y-Y));
-end;
-
-function TFresnelPoint.IsZero: Boolean;
-begin
-  Result:=SameValue(X,0) and SameValue(y,0);
-end;
-
-function TFresnelPoint.Subtract(const p: TFresnelPoint): TFresnelPoint;
-begin
-  Result.x := X-p.X;
-  Result.y := Y-p.Y;
-end;
-
-procedure TFresnelPoint.SetLocation(const p: TFresnelPoint);
-begin
-  X:=p.X;
-  Y:=p.Y;
-end;
-
-procedure TFresnelPoint.SetLocation(const ax, ay: TFresnelLength);
-begin
-  X:=ax;
-  Y:=ay;
-end;
-
-procedure TFresnelPoint.Offset(const p: TFresnelPoint);
-begin
-  X:=X+p.X;
-  Y:=Y+p.Y;
-end;
-
-procedure TFresnelPoint.Offset(const dx, dy: TFresnelLength);
-begin
-  X:=X+dX;
-  Y:=Y+dY;
-end;
-
-function TFresnelPoint.Angle(const p: TFresnelPoint): TFresnelLength;
-
-  function ArcTan2(const y,x: TFresnelLength): TFresnelLength;
-    begin
-      if x=0 then
-        begin
-          if y=0 then
-            Result:=0.0
-          else if y>0 then
-            Result:=pi/2
-          else
-            Result:=-pi/2;
-        end
-      else
-        begin
-          Result:=ArcTan(y/x);
-          if x<0 then
-            if y<0 then
-              Result:=Result-pi
-            else
-              Result:=Result+pi;
-        end;
-    end;
-
-begin
-  Result:=ArcTan2(Y-p.Y,X-p.X);
-end;
-
-class function TFresnelPoint.PointInCircle(const aPoint,
-  aCenter: TFresnelPoint; const aRadius: TFresnelLength): Boolean;
-begin
-  Result := aPoint.Distance(aCenter) <= aRadius;
-end;
-
-class operator TFresnelPoint.=(const p1, p2: TFresnelPoint): Boolean;
-begin
-  Result:=SameValue(p1.X,p2.X) and SameValue(p1.Y,p2.Y);
-end;
-
-class operator TFresnelPoint.<>(const p1, p2: TFresnelPoint): Boolean;
-begin
-  Result:=(not SameValue(p1.X,p2.X)) or (not SameValue(p1.Y,p2.Y));
-end;
-
-class operator TFresnelPoint.+(const p1, p2: TFresnelPoint): TFresnelPoint;
-begin
-  Result.X:=p1.X+p2.X;
-  Result.Y:=p1.Y+p2.Y;
-end;
-
-class operator TFresnelPoint.-(const p1, p2: TFresnelPoint): TFresnelPoint;
-begin
-  Result.X:=p1.X-p2.X;
-  Result.Y:=p1.Y-p2.Y;
-end;
-
-{ TFresnelRect }
-
-procedure TFresnelRect.Clear;
-begin
-  Left:=0.0;
-  Top:=0.0;
-  Right:=0.0;
-  Bottom:=0.0;
-end;
-
-constructor TFresnelRect.Create(const ALeft, ATop, ARight,
-  ABottom: TFresnelLength);
-begin
-  Left := ALeft;
-  Top := ATop;
-  Right := ARight;
-  Bottom := ABottom;
-end;
-
-class operator TFresnelRect.=(const L, R: TFresnelRect): Boolean;
-begin
-  Result := SameValue(L.Left,R.Left) and SameValue(L.Right,R.Right)
-        and SameValue(L.Top,R.Top) and SameValue(L.Bottom,R.Bottom);
-end;
-
-class operator TFresnelRect.<>(const L, R: TFresnelRect): Boolean;
-begin
-  Result := (not SameValue(L.Left,R.Left)) and (not SameValue(L.Right,R.Right))
-        and (not SameValue(L.Top,R.Top)) and (not SameValue(L.Bottom,R.Bottom));
-end;
-
-class operator TFresnelRect.+(const L, R: TFresnelRect): TFresnelRect;
-begin
-  Result := TFresnelRect.Union(L, R);
-end;
-
-class operator TFresnelRect.*(const L, R: TFresnelRect): TFresnelRect;
-begin
-  Result := TFresnelRect.Intersect(L, R);
-end;
-
-class function TFresnelRect.Empty: TFresnelRect;
-begin
-  Result := TFresnelRect.Create(0,0,0,0);
-end;
-
-procedure TFresnelRect.NormalizeRect;
-var
-  h: TFresnelLength;
-begin
-  if Top>Bottom then
-  begin
-    h := Top;
-    Top := Bottom;
-    Bottom := h;
-  end;
-  if Left>Right then
-  begin
-    h := Left;
-    Left := Right;
-    Right := h;
-  end
-end;
-
-function TFresnelRect.IsEmpty: Boolean;
-begin
-  Result := (Right <= Left) or (Bottom <= Top);
-end;
-
-function TFresnelRect.Contains(const P: TFresnelPoint): Boolean;
-begin
-  Result := (Left <= P.X) and (P.X < Right) and (Top <= P.Y) and (P.Y < Bottom);
-end;
-
-function TFresnelRect.Contains(const R: TFresnelRect): Boolean;
-begin
-  Result := (Left <= R.Left) and (R.Right <= Right) and (Top <= R.Top) and (R.Bottom <= Bottom);
-end;
-
-function TFresnelRect.Contains(const ax, ay: TFresnelLength): Boolean;
-begin
-  Result := (Left <= ax) and (ax < Right) and (Top <= ay) and (ay < Bottom);
-end;
-
-function TFresnelRect.IntersectsWith(const R: TFresnelRect): Boolean;
-begin
-  Result := (Left < R.Right) and (R.Left < Right) and (Top < R.Bottom) and (R.Top < Bottom);
-end;
-
-class function TFresnelRect.Intersect(const R1, R2: TFresnelRect): TFresnelRect;
-begin
-  Result.Left:=Max(R1.Left,R2.Left);
-  Result.Right:=Min(R1.Right,R2.Right);
-  Result.Top:=Max(R1.Top,R2.Top);
-  Result.Bottom:=Min(R1.Bottom,R2.Bottom);
-  if Result.IsEmpty then
-    FillByte(Result,SizeOf(TFresnelRect),0);
-end;
-
-procedure TFresnelRect.Intersect(const R: TFresnelRect);
-begin
-  if Left<R.Left then Left:=R.Left;
-  if Right>R.Right then Right:=R.Right;
-  if Top<R.Top then Top:=R.Top;
-  if Bottom>R.Bottom then Bottom:=R.Bottom;
-  if IsEmpty then
-    FillByte(Self,SizeOf(TFresnelRect),0);
-end;
-
-class function TFresnelRect.Union(const R1, R2: TFresnelRect): TFresnelRect;
-begin
-  Result.Left:=Min(R1.Left,R2.Left);
-  Result.Right:=Max(R1.Right,R2.Right);
-  Result.Top:=Min(R1.Top,R2.Top);
-  Result.Bottom:=Max(R1.Bottom,R2.Bottom);
-  if Result.IsEmpty then
-    FillByte(Result,SizeOf(TFresnelRect),0);
-end;
-
-procedure TFresnelRect.Union(const R: TFresnelRect);
-begin
-  if Left>R.Left then Left:=R.Left;
-  if Right<R.Right then Right:=R.Right;
-  if Top>R.Top then Top:=R.Top;
-  if Bottom<R.Bottom then Bottom:=R.Bottom;
-  if IsEmpty then
-    FillByte(Self,SizeOf(TFresnelRect),0);
-end;
-
-class function TFresnelRect.Union(const Points: array of TFresnelPoint
-  ): TFresnelRect;
-var
-  i: Integer;
-begin
-  if Length(Points) > 0 then
-  begin
-    Result.TopLeft := Points[Low(Points)];
-    Result.BottomRight := Points[Low(Points)];
-
-    for i := Low(Points)+1 to High(Points) do
-    begin
-      if Points[i].X < Result.Left then Result.Left := Points[i].X;
-      if Points[i].X > Result.Right then Result.Right := Points[i].X;
-      if Points[i].Y < Result.Top then Result.Top := Points[i].Y;
-      if Points[i].Y > Result.Bottom then Result.Bottom := Points[i].Y;
-    end;
-  end else
-    Result := Empty;
-end;
-
-procedure TFresnelRect.Offset(const DX, DY: TFresnelLength);
-begin
-  Left:=Left+DX;
-  Top:=Top+DY;
-  Right:=Right+DX;
-  Bottom:=Bottom+DY;
-end;
-
-procedure TFresnelRect.Offset(const DP: TFresnelPoint);
-begin
-  Left:=Left+DP.X;
-  Top:=Top+DP.Y;
-  Right:=Right+DP.X;
-  Bottom:=Bottom+DP.Y;
-end;
-
-procedure TFresnelRect.SetLocation(const X, Y: TFresnelLength);
-begin
-  Offset(X-Left, Y-Top);
-end;
-
-procedure TFresnelRect.SetLocation(const P: TFresnelPoint);
-begin
-  Offset(P.X-Left, P.Y-Top);
-end;
-
-procedure TFresnelRect.Inflate(const DX, DY: TFresnelLength);
-begin
-  Left:=Left-DX;
-  Top:=Top-DY;
-  Right:=Right+DX;
-  Bottom:=Bottom+DY;
-end;
-
-procedure TFresnelRect.Inflate(const DL, DT, DR, DB: TFresnelLength);
-begin
-  Left:=Left-DL;
-  Top:=Top-DT;
-  Right:=Right+DR;
-  Bottom:=Bottom+DB;
-end;
-
-function TFresnelRect.CenterPoint: TFresnelPoint;
-begin
-  Result.X := (Left+Right)/2;
-  Result.Y := (Top+Bottom)/2;
-end;
-
 { TFresnelViewport }
 
 procedure TFresnelViewport.CSSResolverLog(Sender: TObject;
@@ -2577,6 +2225,7 @@ begin
   finally
     aParser.Free;
   end;
+  //debugln(['TFresnelElement.SetStyle ',DbgSName(Self),' ',Style]);
   DomChanged;
 end;
 

src/fresnel.events.pas → src/base/fresnel.events.pas

@@ -5,7 +5,7 @@ unit Fresnel.Events;
 interface
 
 uses
-  Classes, SysUtils, FCL.Events;
+  Classes, SysUtils, FCL.Events, Fresnel.Classes;
 
 {$ScopedEnums ON}
 
@@ -38,7 +38,7 @@ Const
   evtFocus = 25;
   evtBlur = 26;
 
-  MaxFresnelEvents = evtBlur;
+  evtLastEvent = evtBlur;
 
 
 Type
@@ -66,7 +66,12 @@ Type
 
   end;
 
-  TMouseButton = (mbMain,mbAux,mbSecond,mbFourth,mbFifth);
+  TMouseButton = (
+    mbMain, // usually left
+    mbAux,  // usually middle wheel
+    mbSecond, // usually right
+    mbFourth,
+    mbFifth);
   TMouseButtons = set of TMouseButton;
 
   { TFresnelMouseEvent }
@@ -74,10 +79,10 @@ Type
   TFresnelMouseEventInit = Record
     Button: TMouseButton;
     Buttons: TMouseButtons;
-    PagePos: TPoint;
-    ScreenPos: TPoint;
+    PagePos: TFresnelPoint;
+    ScreenPos: TFresnelPoint;
     Shiftstate: TShiftState;
-    ControlPos : TPoint;
+    ControlPos: TFresnelPoint;
   end;
 
   TFresnelMouseEvent = Class(TFresnelUIEvent)
@@ -87,12 +92,12 @@ Type
   Public
     Constructor Create(const aInit : TFresnelMouseEventInit); overload;
     Procedure InitEvent(const aInit : TFresnelMouseEventInit);
-    Property PageX : Integer Read FInit.PagePos.X;
-    Property PageY : Integer Read FInit.PagePos.Y;
-    Property ScreenX : Integer Read FInit.ScreenPos.X;
-    Property ScreenY : Integer Read FInit.ScreenPos.Y;
-    Property X : Integer Read FInit.ControlPos.X;
-    Property Y : Integer Read FInit.ControlPos.Y;
+    Property PageX : TFresnelLength Read FInit.PagePos.X;
+    Property PageY : TFresnelLength Read FInit.PagePos.Y;
+    Property ScreenX : TFresnelLength Read FInit.ScreenPos.X;
+    Property ScreenY : TFresnelLength Read FInit.ScreenPos.Y;
+    Property X : TFresnelLength Read FInit.ControlPos.X;
+    Property Y : TFresnelLength Read FInit.ControlPos.Y;
     Property Buttons: TMouseButtons Read FInit.Buttons;
     Property Button : TMouseButton Read FInit.Button;
     Property ShiftState : TShiftState Read FInit.Shiftstate;
@@ -260,7 +265,7 @@ implementation
 uses TypInfo;
 
 Const
-  FresnelEventNames : Array[0..MaxFresnelEvents] of TEventName = (
+  FresnelEventNames : Array[0..evtLastEvent] of TEventName = (
     '?',
     'KeyDown',
     'KeyUp',
@@ -402,7 +407,7 @@ end;
 
 class function TFresnelEvent.StandardEventName(aEventID : TEventID): TEventName;
 begin
-  If (aEventID>=0) and (aEventID<Length(FresnelEventNames)) then
+  If aEventID<Length(FresnelEventNames) then
     Result:=FresnelEventNames[aEventID]
   else
     Result:=IntToStr(aEventID);
@@ -430,7 +435,7 @@ Type
 
 class function TFresnelRegistry.DefaultIDOffset: TEventID;
 begin
-  Result:=MaxFresnelEvents+1;
+  Result:=evtLastEvent+1;
 end;
 
 { TFresnelEventDispatcher }

src/base/fresnel.forms.pas

@@ -0,0 +1,499 @@
+unit Fresnel.Forms;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Math, CustApp, fpCSSResolver, fpCSSTree, LazLogger,
+  LazMethodList, Fresnel.StrConsts, Fresnel.Classes, Fresnel.Resources,
+  Fresnel.DOM, Fresnel.Renderer, Fresnel.Layouter, Fresnel.WidgetSet,
+  Fresnel.Events, fcl.events;
+
+type
+  TDataEvent = procedure (Data: Pointer) of object;
+  TIdleEvent = procedure (Sender: TObject; var Done: Boolean) of object;
+
+  TFormState = (
+    fsMinimized,
+    fsMaximized,
+    fsLayoutQueued
+    );
+  TFormStates = set of TFormState;
+
+  TFormStyle = (fsNormal, fsStayOnTop, fsSplash, fsSystemStayOnTop);
+
+  IFresnelFormDesigner = interface
+    ['{095CB7DD-E291-45B6-892E-F486A38E597C}']
+    function GetDesignerClientHeight: integer;
+    function GetDesignerClientWidth: integer;
+    function GetRenderer: TFresnelRenderer;
+    procedure InvalidateRect(Sender: TObject; ARect: TRect; Erase: boolean);
+    procedure SetDesignerFormBounds(Sender: TObject; NewBounds: TRect);
+  end;
+
+  { TCustomFresnelForm }
+
+  TCustomFresnelForm = class(TFresnelViewport)
+  private
+    FDesigner: IFresnelFormDesigner;
+    FFormBounds: TFresnelRect;
+    FCaption: TFresnelCaption;
+    FFormStates: TFormStates;
+    FFormStyle: TFormStyle;
+    FVisible: boolean;
+    FWSForm: TFresnelWSForm;
+    function GetCaption: TFresnelCaption;
+    function GetFormBounds: TFresnelRect;
+    function GetFormHeight: TFresnelLength;
+    function GetFormLeft: TFresnelLength;
+    function GetFormTop: TFresnelLength;
+    function GetFormWidth: TFresnelLength;
+    function GetLayoutQueued: boolean;
+    function GetRenderer: TFresnelRenderer;
+    function GetWSForm: TFresnelWSForm;
+    procedure SetFormHeight(const AValue: TFresnelLength);
+    procedure SetFormLeft(const AValue: TFresnelLength);
+    procedure SetFormTop(const AValue: TFresnelLength);
+    procedure SetFormWidth(const AValue: TFresnelLength);
+    procedure SetVisible(const AValue: boolean);
+  protected
+    procedure Loaded; override;
+    procedure Notification(AComponent: TComponent; Operation: TOperation);
+      override;
+    procedure OnQueuedLayout({%H-}Data: Pointer); virtual;
+    procedure ProcessResource; virtual;
+    procedure SetCaption(AValue: TFresnelCaption); virtual;
+    procedure SetDesigner(AValue: IFresnelFormDesigner); virtual;
+    procedure SetFormBounds(AValue: TFresnelRect); virtual;
+    procedure SetFormStyle(AValue: TFormStyle); virtual;
+    procedure SetLayoutQueued(const AValue: boolean); virtual;
+    procedure SetWSForm(const AValue: TFresnelWSForm); virtual;
+  public
+    constructor Create(AOwner: TComponent); override;
+    constructor CreateNew(AOwner: TComponent); virtual;
+    destructor Destroy; override;
+    procedure DomChanged; override;
+    procedure Hide; virtual;
+    procedure Show; virtual;
+    procedure Invalidate; virtual;
+    procedure InvalidateRect(const aRect: TFresnelRect); virtual;
+    function GetCSSInitialAttribute(const AttrID: TCSSNumericalID): TCSSString; override;
+    property Designer: IFresnelFormDesigner read FDesigner write SetDesigner;
+  public
+    // widgetset
+    procedure CreateWSForm; virtual;
+    function WSFormAllocated: Boolean;
+    property WSForm: TFresnelWSForm read GetWSForm write SetWSForm;
+    procedure WSDraw; virtual;
+    procedure WSResize(const NewFormBounds: TFresnelRect; NewWidth, NewHeight: TFresnelLength); virtual;
+    procedure WSMouseXY(WSData: TFresnelMouseEventInit; MouseEventId: TEventID); virtual;
+  public
+    property Caption: TFresnelCaption read GetCaption write SetCaption;
+    property FormStates: TFormStates read FFormStates;
+    property LayoutQueued: boolean read GetLayoutQueued write SetLayoutQueued;
+    property Renderer: TFresnelRenderer read GetRenderer;
+    property FormStyle: TFormStyle read FFormStyle write SetFormStyle default fsNormal;
+    property FormBounds: TFresnelRect read GetFormBounds write SetFormBounds;
+    property FormLeft: TFresnelLength read GetFormLeft write SetFormLeft;
+    property FormTop: TFresnelLength read GetFormTop write SetFormTop;
+    property FormWidth: TFresnelLength read GetFormWidth write SetFormWidth;
+    property FormHeight: TFresnelLength read GetFormHeight write SetFormHeight;
+    property Visible: boolean read FVisible write SetVisible default True;
+  end;
+
+  { TFresnelForm }
+
+  TFresnelForm = class(TCustomFresnelForm)
+  published
+    property Caption;
+    property FormLeft;
+    property FormTop;
+    property FormWidth;
+    property FormHeight;
+    property Stylesheet;
+  end;
+
+  { TBaseFresnelApplication }
+
+  TBaseFresnelApplication = class(TCustomApplication)
+  private
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure QueueAsyncCall(const AMethod: TDataEvent; Data: Pointer); virtual; abstract;
+    procedure RemoveAsyncCalls(const AnObject: TObject); virtual; abstract;
+    procedure RemoveAllHandlersOfObject(AnObject: TObject); virtual; abstract;
+    procedure ReleaseComponent(AComponent: TComponent); virtual; abstract;
+  end;
+
+var
+  BaseFresnelApplication: TBaseFresnelApplication;
+
+implementation
+
+{ TCustomFresnelForm }
+
+procedure TCustomFresnelForm.SetFormStyle(AValue: TFormStyle);
+begin
+  if FFormStyle=AValue then Exit;
+  FFormStyle:=AValue;
+  if WSFormAllocated then
+    ;
+end;
+
+function TCustomFresnelForm.GetLayoutQueued: boolean;
+begin
+  Result:=fsLayoutQueued in FFormStates;
+end;
+
+function TCustomFresnelForm.GetRenderer: TFresnelRenderer;
+begin
+  if Designer<>nil then
+    Result:=Designer.GetRenderer
+  else if WSFormAllocated then
+    Result:=WSForm.Renderer
+  else
+    Result:=nil;
+end;
+
+function TCustomFresnelForm.GetFormBounds: TFresnelRect;
+begin
+  Result:=FFormBounds;
+end;
+
+function TCustomFresnelForm.GetCaption: TFresnelCaption;
+begin
+  if WSFormAllocated then
+    FCaption:=WSForm.Caption;
+  Result:=FCaption;
+end;
+
+function TCustomFresnelForm.GetFormHeight: TFresnelLength;
+begin
+  Result:=FFormBounds.Height;
+end;
+
+function TCustomFresnelForm.GetFormLeft: TFresnelLength;
+begin
+  Result:=FFormBounds.Left;
+end;
+
+function TCustomFresnelForm.GetFormTop: TFresnelLength;
+begin
+  Result:=FFormBounds.Top;
+end;
+
+function TCustomFresnelForm.GetFormWidth: TFresnelLength;
+begin
+  Result:=FFormBounds.Width;
+end;
+
+function TCustomFresnelForm.GetWSForm: TFresnelWSForm;
+begin
+  if FWSForm=nil then
+    CreateWSForm;
+  Result:=FWSForm;
+end;
+
+procedure TCustomFresnelForm.SetDesigner(AValue: IFresnelFormDesigner);
+begin
+  if FDesigner=AValue then Exit;
+  FDesigner:=AValue;
+end;
+
+procedure TCustomFresnelForm.SetCaption(AValue: TFresnelCaption);
+begin
+  if FCaption=AValue then exit;
+  FCaption:=AValue;
+  if WSFormAllocated then
+    WSForm.Caption:=AValue;
+end;
+
+procedure TCustomFresnelForm.SetFormBounds(AValue: TFresnelRect);
+begin
+  if Designer<>nil then
+    AValue.SetRect(AValue.GetRect); // round
+  if AValue.Right<AValue.Left then
+    AValue.Right:=AValue.Left;
+  if AValue.Bottom<AValue.Top then
+    AValue.Bottom:=AValue.Top;
+  if FFormBounds=AValue then exit;
+  debugln(['TCustomFresnelForm.SetFormBoundsRect ',DbgSName(Self),' ',dbgs(AValue)]);
+  FFormBounds:=AValue;
+  if Designer<>nil then
+    Designer.SetDesignerFormBounds(Self,FFormBounds.GetRect)
+  else if WSFormAllocated then
+    WSForm.FormBounds:=AValue;
+end;
+
+procedure TCustomFresnelForm.SetFormHeight(const AValue: TFresnelLength);
+begin
+  if FormHeight=AValue then exit;
+  FormBounds:=TFresnelRect.Create(FFormBounds.Left,FFormBounds.Top,FFormBounds.Right,FFormBounds.Top+AValue);
+end;
+
+procedure TCustomFresnelForm.SetFormLeft(const AValue: TFresnelLength);
+begin
+  if FormLeft=AValue then exit;
+  FormBounds:=TFresnelRect.Create(AValue,FFormBounds.Top,AValue+FFormBounds.Width,FFormBounds.Bottom);
+end;
+
+procedure TCustomFresnelForm.SetFormTop(const AValue: TFresnelLength);
+begin
+  if FormTop=AValue then exit;
+  FormBounds:=TFresnelRect.Create(FFormBounds.Left,AValue,FFormBounds.Right,AValue+FFormBounds.Height);
+end;
+
+procedure TCustomFresnelForm.SetFormWidth(const AValue: TFresnelLength);
+begin
+  if FormTop=AValue then exit;
+  FormBounds:=TFresnelRect.Create(FFormBounds.Left,FFormBounds.Top,FFormBounds.Left+AValue,FFormBounds.Bottom);
+end;
+
+procedure TCustomFresnelForm.SetVisible(const AValue: boolean);
+begin
+  if FVisible=AValue then Exit;
+  FVisible:=AValue;
+  if [csDestroying,csLoading,csDesigning]*ComponentState<>[] then
+    exit;
+  if FVisible then
+    Show
+  else
+    Hide;
+end;
+
+procedure TCustomFresnelForm.Loaded;
+begin
+  debugln(['TCustomFresnelForm.Loaded ',DbgSName(Self)]);
+  inherited Loaded;
+  if Visible then
+    Show
+  else
+    Hide;
+end;
+
+procedure TCustomFresnelForm.SetWSForm(const AValue: TFresnelWSForm);
+begin
+  if FWSForm=AValue then exit;
+  if FWSForm<>nil then
+    BaseFresnelApplication.ReleaseComponent(FWSForm);
+  FWSForm:=AValue;
+  if FWSForm<>nil then
+    FreeNotification(FWSForm);
+end;
+
+procedure TCustomFresnelForm.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if Operation=opRemove then
+  begin
+    if FWSForm=AComponent then
+      FWSForm:=nil;
+  end;
+end;
+
+procedure TCustomFresnelForm.OnQueuedLayout(Data: Pointer);
+begin
+  if not LayoutQueued then exit;
+  try
+    ApplyCSS;
+    //Layouter.WriteLayoutTree;
+    Layouter.Apply(Self);
+    Invalidate;
+  finally
+    Exclude(FFormStates,fsLayoutQueued);
+  end;
+end;
+
+procedure TCustomFresnelForm.ProcessResource;
+begin
+  if not InitResourceComponent(Self, TFresnelForm) then
+    DebugLn(Format(rsFormResourceSNotFoundForResourcelessFormsCreateNew, [ClassName]));
+end;
+
+procedure TCustomFresnelForm.SetLayoutQueued(const AValue: boolean);
+begin
+  if LayoutQueued=AValue then Exit;
+  if csDestroying in ComponentState then exit;
+  //if csDestroyingHandle in Form.ControlState then exit;
+  if AValue then
+  begin
+    Include(FFormStates,fsLayoutQueued);
+    BaseFresnelApplication.QueueAsyncCall(@OnQueuedLayout,nil);
+  end else begin
+    Exclude(FFormStates,fsLayoutQueued);
+  end;
+end;
+
+constructor TCustomFresnelForm.Create(AOwner: TComponent);
+begin
+  GlobalNameSpace.BeginWrite;
+  try
+    CreateNew(AOwner);
+    if (ClassType <> TFresnelForm) and (ClassType<>TCustomFresnelForm)
+        and not (csDesigning in ComponentState) then
+    begin
+      ProcessResource;
+    end;
+  finally
+    GlobalNameSpace.EndWrite;
+  end;
+end;
+
+constructor TCustomFresnelForm.CreateNew(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+
+  FVisible:=true;
+  Layouter:=TViewportLayouter.Create(nil);
+  TViewportLayouter(Layouter).Viewport:=Self;
+end;
+
+destructor TCustomFresnelForm.Destroy;
+begin
+  Layouter.Free;
+  Layouter:=nil;
+  WSForm:=nil;
+  inherited Destroy;
+end;
+
+procedure TCustomFresnelForm.DomChanged;
+begin
+  LayoutQueued:=true;
+end;
+
+procedure TCustomFresnelForm.Hide;
+begin
+  writeln('TCustomFresnelForm.Hide ',DbgSName(Self));
+  if Designer<>nil then
+    FVisible:=false
+  else
+    WSForm.Visible:=false;
+end;
+
+procedure TCustomFresnelForm.Show;
+begin
+  writeln('TCustomFresnelForm.Show ',DbgSName(Self));
+  if Designer<>nil then
+    FVisible:=true
+  else
+    WSForm.Visible:=true;
+end;
+
+procedure TCustomFresnelForm.Invalidate;
+begin
+  if Designer<>nil then
+    Designer.InvalidateRect(Self,Rect(0,0,Ceil(Width),Ceil(Height)),false)
+  else if WSFormAllocated then
+    WSForm.Invalidate;
+end;
+
+procedure TCustomFresnelForm.InvalidateRect(const aRect: TFresnelRect);
+begin
+  if Designer<>nil then
+    Designer.InvalidateRect(Self,aRect.GetRect,false)
+  else if WSFormAllocated then
+    WSForm.InvalidateRect(aRect);
+end;
+
+function TCustomFresnelForm.GetCSSInitialAttribute(const AttrID: TCSSNumericalID
+  ): TCSSString;
+var
+  Attr: TFresnelCSSAttribute;
+begin
+  if (AttrID<FresnelElementBaseAttrID) or (AttrID>FresnelElementBaseAttrID+ord(High(TFresnelCSSAttribute))) then
+    exit('');
+  Attr:=TFresnelCSSAttribute(AttrID-FresnelElementBaseAttrID);
+  case Attr of
+  fcaBackgroundColor: Result:='white';
+  fcaColor: Result:='black';
+  else
+    Result:=inherited GetCSSInitialAttribute(AttrID);
+  end;
+end;
+
+procedure TCustomFresnelForm.CreateWSForm;
+begin
+  if WSFormAllocated then exit;
+  if csDestroying in ComponentState then exit;
+
+  // consistency checks
+  debugln(['TCustomFresnelForm.CreateWSForm ',DbgSName(Self)]);
+  if Designer<>nil then
+    raise Exception.Create('TCustomFresnelForm.CreateWSForm Designer<>nil');
+  if Parent = Self then
+    raise Exception.Create('TCustomFresnelForm.CreateWSForm Parent = Self')
+  else if (Parent <> nil) then
+    raise Exception.Create('TCustomFresnelForm.CreateWSForm ToDo 20230915221832');
+
+  // create
+  WidgetSet.CreateWSForm(Self);
+  if not (csLoading in ComponentState) then
+    WSForm.Visible:=Visible;
+end;
+
+function TCustomFresnelForm.WSFormAllocated: Boolean;
+begin
+  Result:=FWSForm<>nil;
+end;
+
+procedure TCustomFresnelForm.WSDraw;
+begin
+  //debugln(['TCustomFresnelForm.WSDraw ',DbgSName(Self),' ',DbgSName(Renderer)]);
+  Renderer.Draw(Self);
+end;
+
+procedure TCustomFresnelForm.WSResize(const NewFormBounds: TFresnelRect;
+  NewWidth, NewHeight: TFresnelLength);
+begin
+  if (FFormBounds=NewFormBounds) and (Width=NewWidth) and (Height=NewHeight) then exit;
+  debugln(['TCustomFresnelForm.WSResize ',DbgSName(Self),' OldForm=',dbgs(FFormBounds),' NewForm=',Dbgs(NewFormBounds),' OldWH=',Width,',',Height,' NewWH=',NewWidth,',',NewHeight]);
+  FFormBounds:=NewFormBounds;
+  Width:=NewWidth;
+  Height:=NewHeight;
+  LayoutQueued:=true;
+end;
+
+procedure TCustomFresnelForm.WSMouseXY(WSData: TFresnelMouseEventInit;
+  MouseEventId: TEventID);
+var
+  El: TFresnelElement;
+  Evt: TFresnelMouseEvent;
+begin
+  El:=GetElementAt(WSData.PagePos.X,WSData.PagePos.Y);
+  WSData.ControlPos:=WSData.PagePos;
+  if El=Nil then
+  begin
+    El:=Self;
+  end else begin
+    // todo: translate ControlPos
+  end;
+  Evt:=El.EventDispatcher.CreateEvent(El,MouseEventId) as TFresnelMouseEvent;
+  try
+    Evt.InitEvent(WSData);
+    El.EventDispatcher.DispatchEvent(Evt);
+  finally
+    Evt.Free;
+  end;
+end;
+
+{ TBaseFresnelApplication }
+
+constructor TBaseFresnelApplication.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  if BaseFresnelApplication<>nil then
+    raise Exception.Create('TBaseFresnelApplication.Create BaseFresnelApplication<>nil');
+  BaseFresnelApplication:=Self;
+end;
+
+destructor TBaseFresnelApplication.Destroy;
+begin
+  inherited Destroy;
+  BaseFresnelApplication:=nil;
+end;
+
+end.
+

src/fresnel.layouter.pas → src/base/fresnel.layouter.pas

@@ -18,8 +18,9 @@ unit Fresnel.Layouter;
 interface
 
 uses
-  Classes, SysUtils, Math, fpCSSResolver, Fresnel.DOM, Fresnel.Controls,
-  LazLoggerBase;
+  Classes, SysUtils, Math, fpCSSResolver,
+  LazLoggerBase,
+  Fresnel.Classes, Fresnel.DOM, Fresnel.Controls;
 
 type
   EFresnelLayout = class(Exception)
@@ -153,9 +154,9 @@ type
     procedure Apply; override;
   end;
 
-  { TSimpleFresnelLayouter }
+  { TViewportLayouter }
 
-  TSimpleFresnelLayouter = class(TFresnelLayouter)
+  TViewportLayouter = class(TFresnelLayouter)
   private
     FViewport: TFresnelViewport;
     procedure SetViewport(const AValue: TFresnelViewport);
@@ -165,7 +166,7 @@ type
     function CreateLayoutNode(El: TFresnelElement): TSimpleFresnelLayoutNode; virtual;
   public
     constructor Create(AOwner: TComponent); override;
-    procedure Apply(aViewport: TFresnelViewport);
+    procedure Apply(aViewport: TFresnelViewport); override;
     function NeedBlockFormattingContext(El: TFresnelElement): boolean; virtual;
     function GetBlockContainer(El: TFresnelElement): TFresnelElement; virtual;
     procedure UpdateLayouter(El: TFresnelElement; LNode: TSimpleFresnelLayoutNode); virtual;
@@ -851,9 +852,9 @@ begin
     Result.Y:=Max(Result.Y,Limit);
 end;
 
-{ TSimpleFresnelLayouter }
+{ TViewportLayouter }
 
-procedure TSimpleFresnelLayouter.SetViewport(const AValue: TFresnelViewport);
+procedure TViewportLayouter.SetViewport(const AValue: TFresnelViewport);
 var
   OldLNode: TFresnelLayoutNode;
 begin
@@ -874,7 +875,7 @@ begin
   end;
 end;
 
-procedure TSimpleFresnelLayouter.ErrorLayout(const ID: int64; const Msg: string);
+procedure TViewportLayouter.ErrorLayout(const ID: int64; const Msg: string);
 var
   s: String;
 begin
@@ -883,7 +884,7 @@ begin
   raise EFresnelLayout.Create(s);
 end;
 
-procedure TSimpleFresnelLayouter.Layout(Node: TSimpleFresnelLayoutNode);
+procedure TViewportLayouter.Layout(Node: TSimpleFresnelLayoutNode);
 var
   i: Integer;
 begin
@@ -899,7 +900,7 @@ begin
   SortStackingContext(Node);
 end;
 
-function TSimpleFresnelLayouter.CreateLayoutNode(El: TFresnelElement
+function TViewportLayouter.CreateLayoutNode(El: TFresnelElement
   ): TSimpleFresnelLayoutNode;
 begin
   if El.LayoutNode<>nil then
@@ -911,12 +912,12 @@ begin
   end;
 end;
 
-constructor TSimpleFresnelLayouter.Create(AOwner: TComponent);
+constructor TViewportLayouter.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
 end;
 
-procedure TSimpleFresnelLayouter.Apply(aViewport: TFresnelViewport);
+procedure TViewportLayouter.Apply(aViewport: TFresnelViewport);
 var
   aDisplayInside, aPosition, aDisplayOutside, aDisplayBox: String;
   VPNode: TSimpleFresnelLayoutNode;
@@ -948,7 +949,7 @@ begin
   Layout(VPNode);
 end;
 
-function TSimpleFresnelLayouter.NeedBlockFormattingContext(El: TFresnelElement
+function TViewportLayouter.NeedBlockFormattingContext(El: TFresnelElement
   ): boolean;
 // BFC
 // contain internal and external floats
@@ -1008,7 +1009,7 @@ begin
   Result:=false;
 end;
 
-function TSimpleFresnelLayouter.GetBlockContainer(El: TFresnelElement
+function TViewportLayouter.GetBlockContainer(El: TFresnelElement
   ): TFresnelElement;
 var
   aValue, aPosition: String;
@@ -1056,7 +1057,7 @@ begin
   end;
 end;
 
-procedure TSimpleFresnelLayouter.UpdateLayouter(El: TFresnelElement;
+procedure TViewportLayouter.UpdateLayouter(El: TFresnelElement;
   LNode: TSimpleFresnelLayoutNode);
 var
   aDisplayInside: String;
@@ -1088,7 +1089,7 @@ begin
   end;
 end;
 
-procedure TSimpleFresnelLayouter.UpdateLayoutParent(El: TFresnelElement;
+procedure TViewportLayouter.UpdateLayoutParent(El: TFresnelElement;
   LNode: TSimpleFresnelLayoutNode);
 var
   ZIndexStr, aPosition: String;
@@ -1132,7 +1133,7 @@ begin
   end;
 end;
 
-function TSimpleFresnelLayouter.GetPixPerUnit(El: TFresnelElement;
+function TViewportLayouter.GetPixPerUnit(El: TFresnelElement;
   anUnit: TFresnelCSSUnit; IsHorizontal: boolean): TFresnelLength;
 var
   B: TFresnelLength;
@@ -1214,7 +1215,7 @@ begin
   end;
 end;
 
-procedure TSimpleFresnelLayouter.ConvertCSSBorderWidthToPix(
+procedure TViewportLayouter.ConvertCSSBorderWidthToPix(
   El: TFresnelElement; Attr: TFresnelCSSAttribute);
 var
   aWidth: String;
@@ -1227,7 +1228,7 @@ begin
   end;
 end;
 
-procedure TSimpleFresnelLayouter.ConvertCSSValueToPixel(El: TFresnelElement;
+procedure TViewportLayouter.ConvertCSSValueToPixel(El: TFresnelElement;
   Attr: TFresnelCSSAttribute; IsHorizontal: boolean);
 var
   aValue: String;
@@ -1315,17 +1316,17 @@ begin
   end;
 
   El.CSSComputedAttribute[Attr]:=FloatToCSSStr(aNumber);
-  //writeln('TFresnelElement.ConvertCSSValueToPixel ',Attr,' ',FCSSComputed[Attr]);
+  //debulgn('TFresnelElement.ConvertCSSValueToPixel ',Attr,' ',FCSSComputed[Attr]);
 end;
 
-procedure TSimpleFresnelLayouter.ComputeCSS(El: TFresnelElement);
+procedure TViewportLayouter.ComputeCSS(El: TFresnelElement);
 var
   Attr: TFresnelCSSAttribute;
   LNode, ParentLNode: TSimpleFresnelLayoutNode;
   aDisplayBox, aVisibility: String;
   {%H-}Code: integer;
 begin
-  writeln('TSimpleFresnelLayouter.ComputeCSS ',El.GetPath);
+  DebugLn('TSimpleFresnelLayouter.ComputeCSS ',El.GetPath);
   // every node gets a layout ndoe
   LNode:=CreateLayoutNode(El);
 
@@ -1361,7 +1362,7 @@ begin
 
   // block container
   LNode.BlockContainer:=GetBlockContainer(El);
-  writeln('TSimpleFresnelLayouter.ComputeCSS ',El.Name,' BlockContainer=',DbgSName(LNode.BlockContainer));
+  DebugLn('TSimpleFresnelLayouter.ComputeCSS ',El.Name,' BlockContainer=',DbgSName(LNode.BlockContainer));
 
   // LayoutParent
   UpdateLayoutParent(El,LNode);
@@ -1388,9 +1389,9 @@ begin
       fcaMarginInlineStart,
       fcaMinWidth,
       fcaMaxWidth,
-      fcaPaddingLeft,
+      fcaPaddingLeft, // all paddings are computed from the width
       fcaPaddingRight,
-      fcaPaddingTop,  // all padding are computed from the width
+      fcaPaddingTop,
       fcaPaddingBottom] do
     ConvertCSSValueToPixel(El,Attr,true);
   for Attr in [
@@ -1405,7 +1406,7 @@ begin
     ConvertCSSValueToPixel(El,Attr,false);
 end;
 
-procedure TSimpleFresnelLayouter.ComputedChildrenCSS(El: TFresnelElement);
+procedure TViewportLayouter.ComputedChildrenCSS(El: TFresnelElement);
 var
   LNode: TSimpleFresnelLayoutNode;
 begin
@@ -1414,7 +1415,7 @@ begin
     LNode.Layouter.ComputedChildrenCSS;
 end;
 
-procedure TSimpleFresnelLayouter.SortStackingContext(LNode: TSimpleFresnelLayoutNode
+procedure TViewportLayouter.SortStackingContext(LNode: TSimpleFresnelLayoutNode
   );
 
   function IsSorted: boolean;
@@ -1450,7 +1451,7 @@ begin
   {$ENDIF}
 end;
 
-procedure TSimpleFresnelLayouter.WriteLayoutTree;
+procedure TViewportLayouter.WriteLayoutTree;
 
   procedure WriteNode(const Prefix: string; Node: TSimpleFresnelLayoutNode);
   var
@@ -1458,10 +1459,10 @@ procedure TSimpleFresnelLayouter.WriteLayoutTree;
     El: TFresnelElement;
   begin
     El:=Node.Element;
-    write(Prefix,El.Name,' NodeCount=',Node.NodeCount,' display-outside=',El.CSSComputedAttribute[fcaDisplayOutside],' display-inside=',El.CSSComputedAttribute[fcaDisplayInside],' position=',El.CSSComputedAttribute[fcaPosition],' z-index=',El.CSSComputedAttribute[fcaZIndex]);
+    dbgout(Prefix,El.Name,' NodeCount=',dbgs(Node.NodeCount),' display-outside=',El.CSSComputedAttribute[fcaDisplayOutside],' display-inside=',El.CSSComputedAttribute[fcaDisplayInside],' position=',El.CSSComputedAttribute[fcaPosition],' z-index=',El.CSSComputedAttribute[fcaZIndex]);
     if Node.Layouter<>nil then
-      write(' layouter=',Node.Layouter.ClassName);
-    writeln;
+      dbgout(' layouter=',Node.Layouter.ClassName);
+    DebugLn;
     for i:=0 to Node.NodeCount-1 do
       WriteNode(Prefix+'  ',TSimpleFresnelLayoutNode(Node.Nodes[i]));
   end;
@@ -1469,17 +1470,17 @@ procedure TSimpleFresnelLayouter.WriteLayoutTree;
 begin
   if Viewport=nil then
   begin
-    writeln('TSimpleFresnelLayouter.WriteLayoutTree Viewport=nil');
+    DebugLn('TSimpleFresnelLayouter.WriteLayoutTree Viewport=nil');
     exit;
   end;
   if Viewport.LayoutNode=nil then
   begin
-    writeln('TSimpleFresnelLayouter.WriteLayoutTree Viewport.LayoutNode=nil');
+    DebugLn('TSimpleFresnelLayouter.WriteLayoutTree Viewport.LayoutNode=nil');
     exit;
   end;
-  writeln('TSimpleFresnelLayouter.WriteLayoutTree BEGIN======================');
+  DebugLn('TSimpleFresnelLayouter.WriteLayoutTree BEGIN======================');
   WriteNode('',TSimpleFresnelLayoutNode(Viewport.LayoutNode));
-  writeln('TSimpleFresnelLayouter.WriteLayoutTree END========================');
+  DebugLn('TSimpleFresnelLayouter.WriteLayoutTree END========================');
 end;
 
 end.

src/base/fresnel.renderer.pas

@@ -0,0 +1,245 @@
+unit Fresnel.Renderer;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Math, FPImage,
+  LazLoggerBase,
+  Fresnel.Classes, Fresnel.DOM, Fresnel.Controls, Fresnel.Layouter;
+
+type
+
+  { TFresnelRenderer }
+
+  TFresnelRenderer = class(TComponent)
+  private
+    FSubPixel: boolean;
+  protected
+    type
+      TBorderAndBackground = class
+      public
+        BorderLeft, BorderTop, BorderRight, BorderBottom: TFresnelLength;
+        BackgroundColorFP: TFPColor;
+        BorderColorFP: TFPColor;
+      end;
+  protected
+    FOrigin: TFresnelPoint;
+    procedure FillRect(const aColor: TFPColor; const aRect: TFresnelRect); virtual; abstract;
+    procedure Line(const aColor: TFPColor; const x1, y1, x2, y2: TFresnelLength); virtual; abstract;
+    procedure TextOut(const aLeft, aTop: TFresnelLength; const aFont: IFresnelFont; const aColor: TFPColor; const aText: string); virtual; abstract;
+    procedure MathRoundRect(var r: TFresnelRect);
+    procedure DrawElBorder(El: TFresnelElement; Params: TBorderAndBackground); virtual;
+    procedure DrawElement(El: TFresnelElement); virtual;
+    procedure DrawChildren(El: TFresnelElement); virtual;
+    procedure UpdateRenderedAttributes(El: TFresnelElement); virtual;
+    procedure SetOrigin(const AValue: TFresnelPoint);
+  public
+    procedure Draw(Viewport: TFresnelViewport); virtual;
+    property SubPixel: boolean read FSubPixel write FSubPixel;
+    property Origin: TFresnelPoint read FOrigin write SetOrigin;
+  end;
+  TFresnelRendererClass = class of TFresnelRenderer;
+
+implementation
+
+{ TFresnelRenderer }
+
+procedure TFresnelRenderer.SetOrigin(const AValue: TFresnelPoint);
+begin
+  if CompareFresnelPoint(FOrigin,AValue)=0 then Exit;
+  FOrigin:=AValue;
+end;
+
+procedure TFresnelRenderer.MathRoundRect(var r: TFresnelRect);
+begin
+  r.Left:=round(r.Left);
+  r.Right:=round(r.Right);
+  r.Top:=round(r.Top);
+  r.Bottom:=round(r.Bottom);
+end;
+
+procedure TFresnelRenderer.DrawElBorder(El: TFresnelElement;
+  Params: TBorderAndBackground);
+var
+  BorderBox: TFresnelRect;
+  i: Integer;
+begin
+  if (Params.BackgroundColorFP.Alpha=alphaTransparent)
+      and (Params.BorderColorFP.Alpha=alphaTransparent) then
+    exit;
+
+  BorderBox:=El.RenderedBorderBox;
+  if not SubPixel then
+    MathRoundRect(BorderBox);
+
+  if Params.BackgroundColorFP.Alpha<>alphaTransparent then
+  begin
+    FillRect(Params.BackgroundColorFP,BorderBox);
+  end;
+  if Params.BorderColorFP.Alpha<>alphaTransparent then
+  begin
+    //debugln(['TFresnelRenderer.DrawElBorder drawing border ',El.Name]);
+    // left border
+    for i:=0 to Ceil(Params.BorderLeft)-1 do
+      Line(Params.BorderColorFP,BorderBox.Left+i,BorderBox.Top,BorderBox.Left+i,BorderBox.Bottom);
+    // right border
+    for i:=0 to ceil(Params.BorderRight)-1 do
+      Line(Params.BorderColorFP,BorderBox.Right-i,BorderBox.Top,BorderBox.Right-i,BorderBox.Bottom);
+    // top border
+    for i:=0 to ceil(Params.BorderTop)-1 do
+      Line(Params.BorderColorFP,BorderBox.Left,BorderBox.Top+i,BorderBox.Right,BorderBox.Top+i);
+    // bottom border
+    for i:=0 to ceil(Params.BorderBottom)-1 do
+      Line(Params.BorderColorFP,BorderBox.Left,BorderBox.Bottom-i,BorderBox.Right,BorderBox.Bottom-i);
+  end;
+end;
+
+procedure TFresnelRenderer.DrawElement(El: TFresnelElement);
+var
+  LNode: TSimpleFresnelLayoutNode;
+  aBackgroundColor, aBorderColor, aCaption, aColor: String;
+  aColorFP: TFPColor;
+  aLeft, aTop, aRight, aBottom,
+    aMarginLeft, aMarginTop, aMarginRight, aMarginBottom,
+    aBorderLeft, aBorderRight, aBorderTop, aBorderBottom,
+    aPaddingLeft, aPaddingRight, aPaddingTop, aPaddingBottom: TFresnelLength;
+  aBorderBox, aContentBox: TFresnelRect;
+  BorderParams: TBorderAndBackground;
+begin
+  //DebugLn(['TFresnelRenderer.DrawElement ',El.GetPath,' Origin=',dbgs(Origin)]);
+  LNode:=TSimpleFresnelLayoutNode(El.LayoutNode);
+  if LNode.SkipRendering then exit;
+
+  El.Rendered:=true;
+  aLeft:=El.GetRenderedCSSLength(fcaLeft,false);
+  aTop:=El.GetRenderedCSSLength(fcaTop,false);
+  aRight:=El.GetRenderedCSSLength(fcaRight,false);
+  aBottom:=El.GetRenderedCSSLength(fcaBottom,false);
+
+  aMarginLeft:=El.GetRenderedCSSLength(fcaMarginLeft,false);
+  aMarginRight:=El.GetRenderedCSSLength(fcaMarginRight,false);
+  aMarginTop:=El.GetRenderedCSSLength(fcaMarginTop,false);
+  aMarginBottom:=El.GetRenderedCSSLength(fcaMarginBottom,false);
+
+  aBorderLeft:=El.GetRenderedCSSLength(fcaBorderLeftWidth,false);
+  aBorderRight:=El.GetRenderedCSSLength(fcaBorderRightWidth,false);
+  aBorderTop:=El.GetRenderedCSSLength(fcaBorderTopWidth,false);
+  aBorderBottom:=El.GetRenderedCSSLength(fcaBorderBottomWidth,false);
+
+  aPaddingLeft:=El.GetRenderedCSSLength(fcaPaddingLeft,false);
+  aPaddingRight:=El.GetRenderedCSSLength(fcaPaddingRight,false);
+  aPaddingTop:=El.GetRenderedCSSLength(fcaPaddingTop,false);
+  aPaddingBottom:=El.GetRenderedCSSLength(fcaPaddingBottom,false);
+
+  aBorderBox.Left:=aLeft+aMarginLeft;
+  aBorderBox.Top:=aTop+aMarginTop;
+  aBorderBox.Right:=aRight-aMarginRight;
+  aBorderBox.Bottom:=aBottom-aMarginBottom;
+  El.RenderedBorderBox:=aBorderBox;
+
+  aContentBox.Left:=aLeft+aMarginLeft+aBorderLeft+aPaddingLeft;
+  aContentBox.Top:=aTop+aMarginTop+aBorderTop+aPaddingTop;
+  aContentBox.Right:=aRight-aMarginRight-aBorderRight-aPaddingRight;
+  aContentBox.Bottom:=aBottom-aMarginBottom-aBorderBottom-aPaddingBottom;
+  El.RenderedContentBox:=aContentBox;
+
+  //DebugLn(['TFresnelRenderer.DrawElement ',El.Name,' Border=',dbgs(aBorderBox),' Content=',dbgs(aContentBox)]);
+
+  BorderParams:=TBorderAndBackground.Create;
+  try
+    BorderParams.BorderLeft:=aBorderLeft;
+    BorderParams.BorderTop:=aBorderTop;
+    BorderParams.BorderRight:=aBorderRight;
+    BorderParams.BorderBottom:=aBorderBottom;
+
+    aBackgroundColor:=El.CSSRenderedAttribute[fcaBackgroundColor];
+    if not CSSToFPColor(aBackgroundColor,BorderParams.BackgroundColorFP) then
+      BorderParams.BackgroundColorFP:=colTransparent;
+
+    aBorderColor:=El.CSSRenderedAttribute[fcaBorderColor];
+    if not CSSToFPColor(aBorderColor,BorderParams.BorderColorFP) then
+      BorderParams.BorderColorFP:=colTransparent;
+
+    DrawElBorder(El,BorderParams);
+  finally
+    BorderParams.Free;
+  end;
+
+  if El is TCustomLabel then
+  begin
+    aCaption:=TCustomLabel(El).RenderedCaption;
+    if aCaption<>'' then
+    begin
+      aColor:=El.GetRenderedCSString(fcaColor,true);
+      if not CSSToFPColor(aColor,aColorFP) then
+        aColorFP:=colTransparent;
+      if aColorFP.Alpha<>alphaTransparent then
+      begin
+        TextOut(aContentBox.Left,aContentBox.Top,El.Font,aColorFP,aCaption);
+      end;
+    end;
+  end;
+
+  DrawChildren(El);
+end;
+
+procedure TFresnelRenderer.DrawChildren(El: TFresnelElement);
+var
+  OldOrigin: TFresnelPoint;
+  LNode: TSimpleFresnelLayoutNode;
+  i: Integer;
+begin
+  LNode:=TSimpleFresnelLayoutNode(El.LayoutNode);
+
+  OldOrigin:=Origin;
+  Origin:=OldOrigin+El.RenderedContentBox.TopLeft;
+  for i:=0 to LNode.NodeCount-1 do
+  begin
+    DrawElement(TSimpleFresnelLayoutNode(LNode.Nodes[i]).Element);
+  end;
+  Origin:=OldOrigin;
+end;
+
+procedure TFresnelRenderer.UpdateRenderedAttributes(El: TFresnelElement);
+var
+  LNode: TSimpleFresnelLayoutNode;
+  i: Integer;
+begin
+  LNode:=TSimpleFresnelLayoutNode(El.LayoutNode);
+  if LNode.SkipRendering then exit;
+
+  El.UpdateRenderedAttributes;
+  for i:=0 to LNode.NodeCount-1 do
+    UpdateRenderedAttributes(TSimpleFresnelLayoutNode(LNode.Nodes[i]).Element);
+end;
+
+procedure TFresnelRenderer.Draw(Viewport: TFresnelViewport);
+var
+  aContentBox: TFresnelRect;
+  aBackgroundColor: String;
+  BackgroundColorFP: TFPColor;
+begin
+  //debugln(['TFresnelRenderer.Draw Origin=',dbgs(Origin)]);
+  UpdateRenderedAttributes(Viewport);
+
+  Viewport.Rendered:=true;
+  aContentBox.Left:=0;
+  aContentBox.Top:=0;
+  aContentBox.Right:=Viewport.Width;
+  aContentBox.Bottom:=Viewport.Height;
+  Viewport.RenderedBorderBox:=aContentBox;
+  Viewport.RenderedContentBox:=aContentBox;
+
+  aBackgroundColor:=Viewport.CSSRenderedAttribute[fcaBackgroundColor];
+  if not CSSToFPColor(aBackgroundColor,BackgroundColorFP) then
+    BackgroundColorFP:=colWhite;
+
+  FillRect(BackgroundColorFP,aContentBox);
+
+  DrawChildren(Viewport);
+end;
+
+end.
+

src/base/fresnel.resources.pas

@@ -0,0 +1,919 @@
+unit Fresnel.Resources;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, TypInfo, Fresnel.StrConsts;
+
+type
+
+  { TFresnelResourceStream }
+
+  TFresnelResourceStream = class(TCustomMemoryStream)
+  private
+    FPRes: TFPResourceHGLOBAL;
+  public
+    constructor CreateFromHandle(Instance: TFPResourceHMODULE; AHandle: TFPResourceHandle); overload;
+    destructor Destroy; override;
+  end;
+
+type
+  TFilerSignature = array[1..4] of Char;
+
+  TLRSItemType = (
+    lrsitCollection,
+    lrsitComponent,
+    lrsitList,
+    lrsitProperty
+  );
+
+  TLRSORStackItem = record
+    Name: string;
+    ItemType: TLRSItemType;
+    Root: TComponent;
+    PushCount: integer; // waiting for this number of Pop
+    ItemNr: integer; // nr in a collection or list
+  end;
+  PLRSORStackItem = ^TLRSORStackItem;
+
+  { TLRSObjectReader }
+
+  TLRSObjectReader = class(TAbstractObjectReader)
+  private
+    FStream: TStream;
+    FBuffer: Pointer;
+    FBufSize: Integer;
+    FBufPos: Integer;
+    FBufEnd: Integer;
+    FStack: PLRSORStackItem;
+    FStackPointer: integer;
+    FStackCapacity: integer;
+    FReader: TReader;
+    procedure SkipProperty;
+    procedure SkipSetBody;
+    procedure Push(ItemType: TLRSItemType; const AName: string = '';
+                   Root: TComponent = nil; PushCount: integer = 1);
+    procedure Pop;
+    procedure ClearStack;
+    function InternalReadValue: TValueType;
+    procedure EndPropertyIfOpen;
+  protected
+    function ReadIntegerContent: integer;
+  public
+    constructor Create(AStream: TStream; BufSize: Integer); virtual;
+    destructor Destroy; override;
+
+    function NextValue: TValueType; override;
+    function ReadValue: TValueType; override;
+    procedure BeginRootComponent; override;
+    procedure BeginComponent(var Flags: TFilerFlags; var AChildPos: Integer;
+      var CompClassName, CompName: String); override;
+    function BeginProperty: String; override;
+    function GetStackPath: string;
+
+    procedure Read(var Buf; Count: LongInt); override;
+    procedure ReadBinary(const DestData: TMemoryStream); override;
+    function ReadFloat: Extended; override;
+    function ReadSingle: Single; override;
+    function ReadCurrency: Currency; override;
+    function ReadDate: TDateTime; override;
+    function ReadIdent(ValueType: TValueType): String; override;
+    function ReadInt8: ShortInt; override;
+    function ReadInt16: SmallInt; override;
+    function ReadInt32: LongInt; override;
+    function ReadInt64: Int64; override;
+    function ReadSet(EnumType: Pointer): Integer; override;
+    procedure ReadSignature; override;
+    function ReadStr: String; override;
+    function ReadString(StringType: TValueType): String; override;
+    function ReadWideString: WideString; override;
+    function ReadUnicodeString: UnicodeString; override;
+    procedure SkipComponent(SkipComponentInfos: Boolean); override;
+    procedure SkipValue; override;
+  public
+    property Stream: TStream read FStream;
+    property Reader: TReader read FReader write FReader;
+  end;
+  TLRSObjectReaderClass = class of TLRSObjectReader;
+
+type
+
+  TPropertyToSkip = record
+    PersistentClass: TPersistentClass;
+    PropertyName: String;
+    Note: String;
+    HelpKeyword: String;
+  end;
+  PRemovedProperty = ^TPropertyToSkip;
+
+  { TPropertiesToSkip }
+
+  TPropertiesToSkip = class(TList)
+  private
+    function GetItem(AIndex: Integer): PRemovedProperty;
+    procedure SetItem(AIndex: Integer; const AValue: PRemovedProperty);
+  protected
+    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
+    procedure DoPropertyNotFound(Reader: TReader; Instance: TPersistent;
+      var PropName: string; IsPath: boolean; var Handled, Skip: Boolean);
+  public
+    function IndexOf(AInstance: TPersistent; const APropertyName: String): Integer; overload;
+    function IndexOf(AClass: TPersistentClass; APropertyName: String): Integer; overload;
+    function Add(APersistentClass: TPersistentClass; const APropertyName, ANote,
+      AHelpKeyWord: string): Integer; reintroduce;
+    property Items[AIndex: Integer]: PRemovedProperty read GetItem write SetItem;
+  end;
+
+const
+  ObjStreamMaskInherited = 1;
+  ObjStreamMaskChildPos  = 2;
+  ObjStreamMaskInline    = 4;
+
+var
+  PropertiesToSkip: TPropertiesToSkip = nil;
+  LRSObjectReaderClass: TLRSObjectReaderClass = TLRSObjectReader;
+
+function InitResourceComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
+
+function CreateLRSReader(s: TStream; var DestroyDriver: boolean): TReader;
+
+function FindResourceLFM(ResName: string): TFPResourceHandle;
+
+implementation
+
+function InitResourceComponent(Instance: TComponent; RootAncestor: TClass
+  ): Boolean;
+
+  function InitComponent(ClassType: TClass): Boolean;
+  var
+    FPResource: TFPResourceHandle;
+    ResName: String;
+    GenericInd: Integer;
+    Stream: TStream;
+    Reader: TReader;
+    DestroyDriver: Boolean;
+    Driver: TAbstractObjectReader;
+  begin
+    //DebugLn(['[InitComponent] ClassType=',ClassType.Classname,' Instance=',DbgsName(Instance),' RootAncestor=',DbgsName(RootAncestor),' ClassType.ClassParent=',DbgsName(ClassType.ClassParent)]);
+    Result := False;
+    if (ClassType = TComponent) or (ClassType = RootAncestor) then
+      Exit;
+    if Assigned(ClassType.ClassParent) then
+      Result := InitComponent(ClassType.ClassParent);
+
+    Stream := nil;
+    ResName := ClassType.ClassName;
+    // Generics class name can contain <> and resource files do not support it
+    GenericInd := ResName.IndexOf('<');
+    if GenericInd > 0 then
+      SetLength(ResName, GenericInd);
+
+    if Stream = nil then
+    begin
+      FPResource := FindResourceLFM(ResName);
+      if FPResource <> 0 then
+        Stream := TFresnelResourceStream.CreateFromHandle(HInstance, FPResource);
+    end;
+
+    if Stream = nil then
+      Exit;
+
+    try
+      DestroyDriver:=false;
+      Reader := CreateLRSReader(Stream, DestroyDriver);
+      try
+        Reader.ReadRootComponent(Instance);
+      finally
+        Driver := Reader.Driver;
+        Reader.Free;
+        if DestroyDriver then
+          Driver.Free;
+      end;
+    finally
+      Stream.Free;
+    end;
+    Result := True;
+  end;
+
+begin
+  if Instance.ComponentState * [csLoading, csInline] <> []
+  then begin
+    // global loading not needed
+    Result := InitComponent(Instance.ClassType);
+  end
+  else try
+    BeginGlobalLoading;
+    Result := InitComponent(Instance.ClassType);
+    NotifyGlobalLoading;
+  finally
+    EndGlobalLoading;
+  end;
+end;
+
+function CreateLRSReader(s: TStream; var DestroyDriver: boolean): TReader;
+var
+  p: Pointer;
+  Driver: TAbstractObjectReader;
+begin
+  Result:=TReader.Create(s,4096);
+  //If included Default translator LRSTranslator will be set
+  //if Assigned(LRSTranslator) then
+  //  Result.OnReadStringProperty:=@(LRSTranslator.TranslateStringProperty);
+
+  Result.OnPropertyNotFound := @(PropertiesToSkip.DoPropertyNotFound);
+
+  DestroyDriver:=false;
+  if Result.Driver.ClassType=LRSObjectReaderClass then
+  begin
+    TLRSObjectReader(Result.Driver).Reader:=Result;
+    exit;
+  end;
+  // hack to set a write protected variable.
+  // DestroyDriver:=true; TReader will free it
+  Driver:=LRSObjectReaderClass.Create(s,4096);
+  p:[email protected];
+  Result.Driver.Free;
+  TAbstractObjectReader(p^):=Driver;
+  TLRSObjectReader(Driver).Reader:=Result;
+end;
+
+function FindResourceLFM(ResName: string): TFPResourceHandle;
+begin
+  Result := FindResource(HInstance,PChar(ResName),
+                         {$ifdef Windows}Windows.{$endif}RT_RCDATA);
+end;
+
+procedure ReadError(Msg: string);
+begin
+  raise EReadError.Create(Msg);
+end;
+
+procedure PropValueError;
+begin
+  ReadError(rsInvalidPropertyValue);
+end;
+
+{ TFresnelResourceStream }
+
+constructor TFresnelResourceStream.CreateFromHandle(
+  Instance: TFPResourceHMODULE; AHandle: TFPResourceHandle);
+begin
+  FPRes := LoadResource(Instance, AHandle);
+  if FPRes <> 0 then
+    SetPointer(LockResource(FPRes), SizeOfResource(Instance, AHandle));
+end;
+
+destructor TFresnelResourceStream.Destroy;
+begin
+  if FPRes <> 0 then
+  begin
+    UnlockResource(FPRes);
+    FreeResource(FPRes);
+  end;
+  inherited Destroy;
+end;
+
+{ TLRSObjectReader }
+
+procedure TLRSObjectReader.Read(var Buf; Count: LongInt);
+var
+  CopyNow: LongInt;
+  Dest: Pointer;
+begin
+  Dest := @Buf;
+  while Count > 0 do
+  begin
+    if FBufPos >= FBufEnd then
+    begin
+      FBufEnd := FStream.Read(FBuffer^, FBufSize);
+      if FBufEnd = 0 then
+        raise EReadError.Create('Read Error');
+      FBufPos := 0;
+    end;
+    CopyNow := FBufEnd - FBufPos;
+    if CopyNow > Count then
+      CopyNow := Count;
+    Move(PChar(FBuffer)[FBufPos], Dest^, CopyNow);
+    Inc(FBufPos, CopyNow);
+    Dest:=Dest+CopyNow;
+    Dec(Count, CopyNow);
+  end;
+end;
+
+procedure TLRSObjectReader.SkipProperty;
+begin
+  { Skip property name, then the property value }
+  ReadStr;
+  SkipValue;
+end;
+
+procedure TLRSObjectReader.SkipSetBody;
+begin
+  while Length(ReadStr) > 0 do;
+end;
+
+procedure TLRSObjectReader.Push(ItemType: TLRSItemType; const AName: string;
+                                Root: TComponent; PushCount: integer);
+begin
+  if FStackPointer=FStackCapacity then begin
+    FStackCapacity:=FStackCapacity*2+10;
+    ReAllocMem(FStack,SizeOf(TLRSORStackItem)*FStackCapacity);
+    FillByte(FStack[FStackPointer],SizeOf(TLRSORStackItem)*(FStackCapacity-FStackPointer),0);
+  end;
+  //DebugLn(['TLRSObjectReader.Push AName=',AName,' Type=', GetEnumName(TypeInfo(TLRSItemType), Integer(ItemType)),' PushCount=',PushCount]);
+  FStack[FStackPointer].Name:=AName;
+  FStack[FStackPointer].ItemType:=ItemType;
+  FStack[FStackPointer].Root:=Root;
+  FStack[FStackPointer].PushCount:=PushCount;
+  FStack[FStackPointer].ItemNr:=-1;
+  inc(FStackPointer);
+end;
+
+procedure TLRSObjectReader.Pop;
+var
+  Item: PLRSORStackItem;
+begin
+  if FStackPointer=0 then
+    raise Exception.Create('Error: TLRSObjectReader.Pop stack is empty');
+  Item:=@FStack[FStackPointer-1];
+  //DebugLn(['TLRSObjectReader.Pop AName=',Item^.Name,
+  //        ' Type=',GetEnumName(TypeInfo(TLRSItemType), Integer(item^.ItemType)),
+  //        ' PushCount=',item^.PushCount,' StackPtr=', FStackPointer]);
+  if Item^.PushCount>1 then begin
+    // stack item still needs more EndList
+    dec(Item^.PushCount);
+  end else begin
+    // stack item is complete
+    dec(FStackPointer);
+  end;
+end;
+
+procedure TLRSObjectReader.ClearStack;
+var
+  i: Integer;
+begin
+  for i:=0 to FStackCapacity-1 do begin
+    FStack[i].Name:='';
+  end;
+  ReAllocMem(FStack,0);
+end;
+
+function TLRSObjectReader.InternalReadValue: TValueType;
+var
+  b: byte;
+begin
+  Result := vaNull; { Necessary in FPC as TValueType is larger than 1 byte! }
+  Read(b,1);
+  Result:=TValueType(b);
+end;
+
+function TLRSObjectReader.ReadIntegerContent: integer;
+begin
+  Result:=0;
+  Read(Result,4);
+  {$ifdef FPC_BIG_ENDIAN}
+  ReverseBytes(@Result,4);
+  {$endif}
+end;
+
+constructor TLRSObjectReader.Create(AStream: TStream; BufSize: Integer);
+begin
+  inherited Create;
+  FStream := AStream;
+  FBufSize := BufSize;
+  GetMem(FBuffer, BufSize);
+end;
+
+destructor TLRSObjectReader.Destroy;
+begin
+  { Seek back the amount of bytes that we didn't process until now: }
+  if Assigned(FStream) then
+    FStream.Seek(Integer(FBufPos) - Integer(FBufEnd), soFromCurrent);
+
+  if Assigned(FBuffer) then
+    FreeMem(FBuffer, FBufSize);
+
+  ClearStack;
+
+  inherited Destroy;
+end;
+
+function TLRSObjectReader.ReadValue: TValueType;
+begin
+  Result := InternalReadValue;
+  case Result of
+    vaNull:
+      begin
+        EndPropertyIfOpen;
+        // End previous element collection, list or component.
+        if FStackPointer > 0 then
+          Pop;
+      end;
+    vaCollection:
+      begin
+        Push(lrsitCollection);
+      end;
+    vaList:
+      begin
+        // Increase counter for next collection item.
+        if (FStackPointer > 0) and (FStack[FStackPointer-1].ItemType = lrsitCollection) then
+          Inc(FStack[FStackPointer-1].ItemNr);
+        Push(lrsitList);
+      end;
+  end;
+end;
+
+function TLRSObjectReader.NextValue: TValueType;
+begin
+  Result := InternalReadValue;
+  { We only 'peek' at the next value, so seek back to unget the read value: }
+  Dec(FBufPos);
+end;
+
+procedure TLRSObjectReader.BeginRootComponent;
+var
+  Signature: TFilerSignature;
+begin
+  { Read filer signature }
+  Signature:='1234';
+  Read(Signature[1],length(Signature));
+  if Signature <> FilerSignature then
+    raise EReadError.Create('Invalid Filer Signature');
+end;
+
+procedure TLRSObjectReader.BeginComponent(var Flags: TFilerFlags;
+  var AChildPos: Integer; var CompClassName, CompName: String);
+var
+  Prefix: Byte;
+  ValueType: TValueType;
+  ItemName: String;
+  ItemRoot: TComponent;
+begin
+  { Every component can start with a special prefix: }
+  Flags := [];
+  if (Byte(NextValue) and $f0) = $f0 then
+  begin
+    Prefix := Byte(ReadValue);
+    if (ObjStreamMaskInherited and Prefix)<>0 then
+      Include(Flags,ffInherited);
+    if (ObjStreamMaskInline and Prefix)<>0 then
+      Include(Flags,ffInline);
+    if (ObjStreamMaskChildPos and Prefix)<>0 then
+    begin
+      Include(Flags,ffChildPos);
+      ValueType := ReadValue;
+      case ValueType of
+        vaInt8:
+          AChildPos := ReadInt8;
+        vaInt16:
+          AChildPos := ReadInt16;
+        vaInt32:
+          AChildPos := ReadInt32;
+        else
+          PropValueError;
+      end;
+    end;
+  end;
+
+  CompClassName := ReadStr;
+  CompName := ReadStr;
+
+  // Top component is addressed by ClassName.
+  if FStackPointer = 0 then
+  begin
+    ItemName := CompClassName;
+    ItemRoot := nil;
+  end
+  else
+  begin
+    ItemName := CompName;
+    if Assigned(Reader) then
+      // Reader.LookupRoot is the current Root component.
+      ItemRoot := Reader.LookupRoot
+    else
+      ItemRoot := nil;
+  end;
+
+  // A component has two lists: properties and childs, hence PopCount=2.
+  Push(lrsitComponent, ItemName, ItemRoot, 2);
+end;
+
+function TLRSObjectReader.BeginProperty: String;
+begin
+  EndPropertyIfOpen;
+  Result := ReadStr;
+  Push(lrsitProperty, Result);
+end;
+
+procedure TLRSObjectReader.EndPropertyIfOpen;
+begin
+  // End previous property.
+  if (FStackPointer > 0) and (FStack[FStackPointer-1].ItemType = lrsitProperty) then
+    Pop;
+end;
+
+function TLRSObjectReader.GetStackPath: string;
+var
+  i: Integer;
+  CurName: string;
+  Item: PLRSORStackItem;
+begin
+  Result:='';
+
+  for i:=0 to FStackPointer-1 do
+  begin
+    Item := @FStack[i];
+
+    // Reader.Root is the top component in the module.
+    if Assigned(Reader) and
+       (Item^.ItemType = lrsitComponent) and
+       (Item^.Root = Reader.Root) and
+       (Item^.Root <> nil) then
+    begin
+      // Restart path from top component.
+      Result := Item^.Root.ClassName;
+    end;
+
+    CurName:=Item^.Name;
+    if CurName<>'' then begin
+      if Result<>'' then Result:=Result+'.';
+      Result:=Result+CurName;
+    end;
+    if Item^.ItemNr >= 0 then
+      Result := Result + '[' + IntToStr(Item^.ItemNr) + ']';
+  end;
+end;
+
+procedure TLRSObjectReader.ReadBinary(const DestData: TMemoryStream);
+var
+  BinSize: LongInt;
+begin
+  BinSize:=ReadIntegerContent;
+  DestData.Size := BinSize;
+  Read(DestData.Memory^, BinSize);
+end;
+
+function TLRSObjectReader.ReadFloat: Extended;
+{$ifndef FPC_HAS_TYPE_EXTENDED}
+var
+  e: array[1..10] of byte;
+{$endif}
+begin
+  Result:=0;
+  {$ifdef FPC_HAS_TYPE_EXTENDED}
+    Read(Result, 10);
+    {$ifdef FPC_BIG_ENDIAN}
+      ReverseBytes(@Result, 10);
+    {$endif FPC_BIG_ENDIAN}
+  {$else FPC_HAS_TYPE_EXTENDED}
+    Read(e, 10);
+    Result := ConvertLRSExtendedToDouble(@e);
+  {$endif FPC_HAS_TYPE_EXTENDED}
+end;
+
+function TLRSObjectReader.ReadSingle: Single;
+begin
+  Result:=0;
+  Read(Result, 4);
+  {$ifdef FPC_BIG_ENDIAN}
+  ReverseBytes(@Result,4);
+  {$endif}
+end;
+
+function TLRSObjectReader.ReadCurrency: Currency;
+begin
+  Result:=0;
+  Read(Result, 8);
+  {$ifdef FPC_BIG_ENDIAN}
+  ReverseBytes(@Result,8);
+  {$endif}
+end;
+
+function TLRSObjectReader.ReadDate: TDateTime;
+begin
+  Result:=0;
+  Read(Result, 8);
+  {$ifdef FPC_BIG_ENDIAN}
+  ReverseBytes(@Result,8);
+  {$endif}
+end;
+
+function TLRSObjectReader.ReadIdent(ValueType: TValueType): String;
+var
+  b: Byte;
+begin
+  case ValueType of
+    vaIdent:
+      begin
+        Read(b, 1);
+        SetLength(Result, b);
+        if ( b > 0 ) then
+          Read(Result[1], b);
+      end;
+    vaNil:
+      Result := 'nil';
+    vaFalse:
+      Result := 'False';
+    vaTrue:
+      Result := 'True';
+    vaNull:
+      Result := 'Null';
+  else
+    Result:='';
+    ReadError('TLRSObjectReader.ReadIdent unknown ValueType '+IntToStr(ord(ValueType)));
+  end;
+end;
+
+function TLRSObjectReader.ReadInt8: ShortInt;
+begin
+  Result:=0;
+  Read(Result, 1);
+end;
+
+function TLRSObjectReader.ReadInt16: SmallInt;
+begin
+  Result:=0;
+  Read(Result, 2);
+  {$ifdef FPC_BIG_ENDIAN}
+  ReverseBytes(@Result,2);
+  {$endif}
+end;
+
+function TLRSObjectReader.ReadInt32: LongInt;
+begin
+  Result:=0;
+  Read(Result, 4);
+  {$ifdef FPC_BIG_ENDIAN}
+  ReverseBytes(@Result,4);
+  {$endif}
+end;
+
+function TLRSObjectReader.ReadInt64: Int64;
+begin
+  Result:=0;
+  Read(Result, 8);
+  {$ifdef FPC_BIG_ENDIAN}
+  ReverseBytes(@Result,8);
+  {$endif}
+end;
+
+function TLRSObjectReader.ReadSet(EnumType: Pointer): Integer;
+type
+  tset = set of 0..31;
+var
+  OName: String;
+  OValue: Integer;
+begin
+  try
+    Result := 0;
+    while True do
+    begin
+      OName := ReadStr;
+      if Length(OName) = 0 then
+        break;
+      OValue := GetEnumValue(PTypeInfo(EnumType), OName);
+      // Eg. "Options" is a set and can give an error when changing component type.
+      // Do nothing on error (OValue = -1), was PropValueError;  (JuMa)
+      if OValue >= 0 then
+        include(tset(result),OValue);
+    end;
+  except
+    SkipSetBody;
+    raise;
+  end;
+end;
+
+procedure TLRSObjectReader.ReadSignature;
+begin
+end;
+
+function TLRSObjectReader.ReadStr: String;
+var
+  b: Byte;
+begin
+  Read(b, 1);
+  SetLength(Result, b);
+  if b > 0 then
+    Read(Result[1], b);
+end;
+
+function TLRSObjectReader.ReadString(StringType: TValueType): String;
+var
+  i: Integer;
+  b: byte;
+begin
+  case StringType of
+    vaString:
+      begin
+        Read(b, 1);
+        i:=b;
+      end;
+    vaLString:
+      i:=ReadIntegerContent;
+  else
+    raise Exception.Create('TLRSObjectReader.ReadString invalid StringType');
+  end;
+  SetLength(Result, i);
+  if i > 0 then
+    Read(Pointer(@Result[1])^, i);
+end;
+
+function TLRSObjectReader.ReadWideString: WideString;
+var
+  i: Integer;
+begin
+  i:=ReadIntegerContent;
+  SetLength(Result, i);
+  if i > 0 then
+    Read(Pointer(@Result[1])^, i*2);
+  //debugln('TLRSObjectReader.ReadWideString ',Result);
+end;
+
+function TLRSObjectReader.ReadUnicodeString: UnicodeString;
+var
+  i: Integer;
+begin
+  i:=ReadIntegerContent;
+  SetLength(Result, i);
+  if i > 0 then
+    Read(Pointer(@Result[1])^, i*2);
+  //debugln('TLRSObjectReader.ReadWideString ',Result);
+end;
+
+procedure TLRSObjectReader.SkipComponent(SkipComponentInfos: Boolean);
+var
+  Flags: TFilerFlags;
+  Dummy: Integer;
+  CompClassName, CompName: String;
+begin
+  if SkipComponentInfos then
+    { Skip prefix, component class name and component object name }
+    BeginComponent(Flags, Dummy, CompClassName, CompName);
+
+  { Skip properties }
+  while NextValue <> vaNull do
+    SkipProperty;
+  ReadValue;
+
+  { Skip children }
+  while NextValue <> vaNull do
+    SkipComponent(True);
+  ReadValue;
+end;
+
+procedure TLRSObjectReader.SkipValue;
+
+  procedure SkipBytes(Count: LongInt);
+  var
+    Dummy: array[0..1023] of Byte;
+    SkipNow: Integer;
+  begin
+    while Count > 0 do
+    begin
+      if Count > 1024 then
+        SkipNow := 1024
+      else
+        SkipNow := Count;
+      Read(Dummy, SkipNow);
+      Dec(Count, SkipNow);
+    end;
+  end;
+
+var
+  Count: LongInt;
+begin
+  case ReadValue of
+    vaNull, vaFalse, vaTrue, vaNil: ;
+    vaList:
+      begin
+        while NextValue <> vaNull do
+          SkipValue;
+        ReadValue;
+      end;
+    vaInt8:
+      SkipBytes(1);
+    vaInt16:
+      SkipBytes(2);
+    vaInt32:
+      SkipBytes(4);
+    vaExtended:
+      SkipBytes(10);
+    vaString, vaIdent:
+      ReadStr;
+    vaBinary, vaLString:
+      begin
+        Count:=ReadIntegerContent;
+        SkipBytes(Count);
+      end;
+    vaWString, vaUString:
+      begin
+        Count:=ReadIntegerContent;
+        SkipBytes(Count*2);
+      end;
+    vaSet:
+      SkipSetBody;
+    vaCollection:
+      begin
+        while NextValue <> vaNull do
+        begin
+          { Skip the order value if present }
+          if NextValue in [vaInt8, vaInt16, vaInt32] then
+            SkipValue;
+          SkipBytes(1);
+          while NextValue <> vaNull do
+            SkipProperty;
+          ReadValue;
+        end;
+        ReadValue;
+      end;
+    vaSingle:
+      SkipBytes(4);
+    vaCurrency:
+      SkipBytes(SizeOf(Currency));
+    vaDate:
+      SkipBytes(8);
+    vaInt64:
+      SkipBytes(8);
+  else
+    ReadError('TLRSObjectReader.SkipValue unknown valuetype');
+  end;
+end;
+
+{ TPropertiesToSkip }
+
+function TPropertiesToSkip.GetItem(AIndex: Integer): PRemovedProperty;
+begin
+  Result := inherited Get(AIndex);
+end;
+
+procedure TPropertiesToSkip.SetItem(AIndex: Integer;
+  const AValue: PRemovedProperty);
+begin
+  inherited Put(AIndex, AValue);
+end;
+
+procedure TPropertiesToSkip.Notify(Ptr: Pointer; Action: TListNotification);
+begin
+  if Action = lnDeleted then
+    Dispose(PRemovedProperty(Ptr))
+  else
+    inherited Notify(Ptr, Action);
+end;
+
+procedure TPropertiesToSkip.DoPropertyNotFound(Reader: TReader; Instance: TPersistent;
+  var PropName: string; IsPath: boolean; var Handled, Skip: Boolean);
+begin
+  Skip := IndexOf(Instance, PropName) >= 0;
+  Handled := Skip;
+end;
+
+function TPropertiesToSkip.IndexOf(AInstance: TPersistent;
+  const APropertyName: String): Integer;
+begin
+  if AInstance <> nil then
+    Result := IndexOf(TPersistentClass(AInstance.ClassType), APropertyName)
+  else
+    Result := -1;
+end;
+
+function TPropertiesToSkip.IndexOf(AClass: TPersistentClass;
+  APropertyName: String): Integer;
+var
+  PropertyInfo: PRemovedProperty;
+begin
+  APropertyName := LowerCase(APropertyName);
+  Result := Count - 1;
+  while Result >= 0 do
+  begin
+    PropertyInfo := Items[Result];
+    if AClass.InheritsFrom(PropertyInfo^.PersistentClass) and
+       (APropertyName = PropertyInfo^.PropertyName) then
+    begin
+      Exit;
+    end;
+    Dec(Result);
+  end;
+  Result := -1;
+end;
+
+function TPropertiesToSkip.Add(APersistentClass: TPersistentClass;
+  const APropertyName, ANote, AHelpKeyWord: string): Integer;
+var
+  Item: PRemovedProperty;
+begin
+  Result := IndexOf(APersistentClass, APropertyName);
+  if Result = -1 then
+  begin
+    New(Item);
+    Item^.PersistentClass := APersistentClass;
+    Item^.PropertyName := LowerCase(APropertyName);
+    Item^.Note := ANote;
+    Item^.HelpKeyword := AHelpKeyWord;
+    Result := inherited Add(Item);
+  end;
+end;
+
+end.
+

src/base/fresnel.strconsts.pas

@@ -0,0 +1,15 @@
+unit Fresnel.StrConsts;
+
+{$mode objfpc}{$H+}
+
+interface
+
+resourcestring
+  rsFormResourceSNotFoundForResourcelessFormsCreateNew = 'Form resource %s '
+    +'not found. For resourceless forms CreateNew constructor must be used.';
+  rsInvalidPropertyValue = 'Invalid property value';
+
+implementation
+
+end.
+

src/base/fresnel.widgetset.pas

@@ -0,0 +1,110 @@
+unit Fresnel.WidgetSet;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Fresnel.Classes, Fresnel.DOM, Fresnel.Renderer;
+
+type
+  TFreHandle = Pointer;
+
+  { TFresnelWSForm }
+
+  TFresnelWSForm = class(TComponent)
+  private
+  protected
+    FRenderer: TFresnelRenderer;
+    function GetCaption: TFresnelCaption; virtual; abstract;
+    function GetFormBounds: TFresnelRect; virtual; abstract;
+    function GetVisible: boolean; virtual; abstract;
+    procedure SetCaption(AValue: TFresnelCaption); virtual; abstract;
+    procedure SetFormBounds(const AValue: TFresnelRect); virtual; abstract;
+    procedure SetVisible(const AValue: boolean); virtual; abstract;
+  public
+    function GetClientSize: TFresnelPoint; virtual; abstract;
+    procedure Invalidate; virtual;
+    procedure InvalidateRect(const aRect: TFresnelRect); virtual; abstract;
+    property Caption: TFresnelCaption read GetCaption write SetCaption;
+    property FormBounds: TFresnelRect read GetFormBounds write SetFormBounds;
+    property Renderer: TFresnelRenderer read FRenderer;
+    property Visible: boolean read GetVisible write SetVisible;
+  end;
+  TFresnelWSFormClass = class of TFresnelWSForm;
+
+  { TFresnelWidgetSet }
+
+  TFresnelWidgetSet = class(TComponent)
+  protected
+    FWSFormClass: TFresnelWSFormClass;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    procedure AppWaitMessage; virtual; abstract;
+    procedure AppProcessMessages; virtual; abstract;
+    procedure AppTerminate; virtual; abstract;
+    procedure AppSetTitle(const ATitle: string); virtual;
+
+    // Begin/End processing messages, which can be used to acquire/release
+    // resources during message processing.
+    // for example, on Cocoa, it needs to be used to release AutoReleasePool
+    // to avoid resource leaks.
+    function  BeginMessageProcess: TFreHandle; virtual;
+    procedure EndMessageProcess(Context: TFreHandle); virtual;
+
+    procedure CreateWSForm(aFresnelForm: TFresnelComponent); virtual; abstract;
+    property WSFormClass: TFresnelWSFormClass read FWSFormClass;
+  end;
+
+var
+  WidgetSet: TFresnelWidgetSet;
+
+implementation
+
+{ TFresnelWSForm }
+
+procedure TFresnelWSForm.Invalidate;
+var
+  aRect: TFresnelRect;
+begin
+  aRect.Left:=0;
+  aRect.Top:=0;
+  aRect.BottomRight:=GetClientSize;
+  InvalidateRect(aRect);
+end;
+
+{ TFresnelWidgetSet }
+
+constructor TFresnelWidgetSet.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  if WidgetSet<>nil then
+    raise Exception.Create('20230908113733');
+  WidgetSet:=Self;
+end;
+
+destructor TFresnelWidgetSet.Destroy;
+begin
+  WidgetSet:=nil;
+  inherited Destroy;
+end;
+
+procedure TFresnelWidgetSet.AppSetTitle(const ATitle: string);
+begin
+  if ATitle='' then ;
+end;
+
+function TFresnelWidgetSet.BeginMessageProcess: TFreHandle;
+begin
+  Result:=nil;
+end;
+
+procedure TFresnelWidgetSet.EndMessageProcess(Context: TFreHandle);
+begin
+  if Context<>nil then ;
+end;
+
+end.
+

src/base/fresnelbase.lpk

@@ -0,0 +1,86 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <Package Version="5">
+    <Name Value="FresnelBase"/>
+    <Author Value="Mattias Gaertner"/>
+    <CompilerOptions>
+      <Version Value="11"/>
+      <SearchPaths>
+        <OtherUnitFiles Value="$(FPCSrcDir)/packages/fcl-css/src;css;lcl"/>
+        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <Parsing>
+        <SyntaxOptions>
+          <AllowLabel Value="False"/>
+        </SyntaxOptions>
+      </Parsing>
+    </CompilerOptions>
+    <Description Value="The abstract Fresnel Framework - providing CSS components.
+"/>
+    <License Value="modified LGPL-2
+"/>
+    <Version Minor="3"/>
+    <Files>
+      <Item>
+        <Filename Value="fresnel.controls.pas"/>
+        <UnitName Value="Fresnel.Controls"/>
+      </Item>
+      <Item>
+        <Filename Value="fresnel.dom.pas"/>
+        <UnitName Value="Fresnel.DOM"/>
+      </Item>
+      <Item>
+        <Filename Value="fresnel.layouter.pas"/>
+        <UnitName Value="Fresnel.Layouter"/>
+      </Item>
+      <Item>
+        <Filename Value="fresnel.renderer.pas"/>
+        <UnitName Value="Fresnel.Renderer"/>
+      </Item>
+      <Item>
+        <Filename Value="fcl.events.pas"/>
+        <UnitName Value="fcl.events"/>
+      </Item>
+      <Item>
+        <Filename Value="fresnel.events.pas"/>
+        <UnitName Value="Fresnel.Events"/>
+      </Item>
+      <Item>
+        <Filename Value="fresnel.forms.pas"/>
+        <UnitName Value="Fresnel.Forms"/>
+      </Item>
+      <Item>
+        <Filename Value="fresnel.widgetset.pas"/>
+        <UnitName Value="Fresnel.WidgetSet"/>
+      </Item>
+      <Item>
+        <Filename Value="fresnel.resources.pas"/>
+        <UnitName Value="Fresnel.Resources"/>
+      </Item>
+      <Item>
+        <Filename Value="fresnel.strconsts.pas"/>
+        <UnitName Value="Fresnel.StrConsts"/>
+      </Item>
+      <Item>
+        <Filename Value="fresnel.classes.pas"/>
+        <UnitName Value="Fresnel.Classes"/>
+      </Item>
+      <Item>
+        <Filename Value="fresnel.app.pas"/>
+        <UnitName Value="Fresnel.App"/>
+      </Item>
+    </Files>
+    <RequiredPkgs>
+      <Item>
+        <PackageName Value="LazUtils"/>
+      </Item>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>

src/base/fresnelbase.pas

@@ -0,0 +1,17 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit FresnelBase;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+  Fresnel.Controls, Fresnel.DOM, Fresnel.Layouter, Fresnel.Renderer, 
+  fcl.events, Fresnel.Events, Fresnel.Forms, Fresnel.WidgetSet, 
+  Fresnel.Resources, Fresnel.StrConsts, Fresnel.Classes, Fresnel.App;
+
+implementation
+
+end.

src/fresnel.fresnelall.pas

@@ -0,0 +1,15 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit Fresnel.FresnelAll;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+  Fresnel;
+
+implementation
+
+end.

src/fresnel.lpk

@@ -2,94 +2,122 @@
 <CONFIG>
   <Package Version="5">
     <Name Value="Fresnel"/>
-    <Type Value="RunAndDesignTime"/>
     <Author Value="Mattias Gaertner"/>
     <CompilerOptions>
       <Version Value="11"/>
       <SearchPaths>
-        <OtherUnitFiles Value="$(FPCSrcDir)/packages/fcl-css/src;css;lcl"/>
+        <OtherUnitFiles Value="skia/skia4delphi"/>
         <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
       <Conditionals Value="// FresnelBackend
 if FresnelBackend+&apos;&apos;=&apos;&apos; then begin
-  if (SrcOS=&apos;unix&apos;) then
-    FresnelBackend := &apos;gtk3skia&apos;
+  if (TargetOS=&apos;win32&apos;) or (TargetOS=&apos;win64&apos;) then
+    FresnelBackend := &apos;winapi&apos;
+  else if TargetOS=&apos;darwin&apos; then
+    FresnelBackend := &apos;cocoa&apos;
   else
-    FresnelBackend:=&apos;none&apos;;
-  end;
+    FresnelBackend := &apos;gtk3&apos;;
+end;
+// FresnelRenderer
+if FresnelRenderer+&apos;&apos;=&apos;&apos; then begin
+  FresnelRenderer := &apos;skia&apos;;
 end;
 
-// widget set specific options
-if FresnelBackend=&apos;gtk3skia&apos; then
-begin
-  CustomOptions := &apos;-dgtk3 -dskia&apos;;
-  UnitPath := &apos;skia;gtk3;$PkgDir(LCL)/interfaces/gtk3/gtk3bindings&apos;;
+// backend specific options
+if FresnelBackend=&apos;gtk3&apos; then begin
+  CustomOptions := &apos;-dFresnelGtk3&apos;;
+  UnitPath := &apos;gtk3;$PkgDir(LCL)/gtk3/gtk3bindings&apos;;
+end else if FresnelBackend=&apos;cocoa&apos; then begin
+  CustomOptions := &apos;-dFresnelCocoa&apos;;
+  UnitPath := &apos;cocoa&apos;;
+end else if FresnelBackend=&apos;winapi&apos; then begin
+  CustomOptions := &apos;-dFresnelWinapi&apos;;
+  UnitPath := &apos;winapi&apos;;
+end;
+if FresnelRenderer=&apos;skia&apos; then begin
+  CustomOptions += &apos; -dFresnelSkia&apos;;
+  UnitPath += &apos;;skia;skia/skia4delphi&apos;;
 end;
 
 // linker options
 if TargetOS=&apos;darwin&apos; then begin
-  if FresnelBackend=&apos;cocoaskia&apos; then
+  if FresnelBackend=&apos;gtk3&apos; then
+    UsageLibraryPath := &apos;/usr/X11R6/lib;/sw/lib;/sw/lib/pango-ft219/lib&apos;
+  else if FresnelBackend=&apos;cocoa&apos; then
     UsageLinkerOptions := &apos;-framework Cocoa&apos;;
 end;"/>
       <BuildMacros>
-        <Count Value="1"/>
+        <Count Value="2"/>
         <Item1>
           <Identifier Value="FresnelBackend"/>
-          <Values Count="4">
-            <Item1 Value="lcl"/>
-            <Item2 Value="gtk3skia"/>
-            <Item3 Value="cocoaskia"/>
-            <Item4 Value="winapiskia"/>
+          <Values Count="3">
+            <Item1 Value="Gtk3"/>
+            <Item2 Value="Cocoa"/>
+            <Item3 Value="WinApi"/>
           </Values>
+          <ValueDescriptions Count="3"/>
         </Item1>
+        <Item2>
+          <Identifier Value="FresnelRenderer"/>
+          <Values Count="1">
+            <Item1 Value="Skia"/>
+          </Values>
+          <ValueDescriptions Count="1"/>
+        </Item2>
       </BuildMacros>
+      <Parsing>
+        <SyntaxOptions>
+          <AllowLabel Value="False"/>
+        </SyntaxOptions>
+      </Parsing>
+      <Other>
+        <ConfigFile>
+          <WriteConfigFilePath Value=""/>
+        </ConfigFile>
+      </Other>
     </CompilerOptions>
-    <Description Value="CSS components"/>
-    <License Value="modified LGPL-2
-"/>
-    <Version Minor="2"/>
-    <Files Count="8">
-      <Item1>
-        <Filename Value="fresnel.controls.pas"/>
-        <UnitName Value="fresnel.controls"/>
-      </Item1>
-      <Item2>
-        <Filename Value="fresnel.dom.pas"/>
-        <UnitName Value="fresnel.dom"/>
-      </Item2>
-      <Item3>
-        <Filename Value="fresnel.layouter.pas"/>
-        <UnitName Value="fresnel.layouter"/>
-      </Item3>
-      <Item4>
-        <Filename Value="fresnel.renderer.pas"/>
-        <UnitName Value="fresnel.renderer"/>
-      </Item4>
-      <Item5>
-        <Filename Value="fcl.events.pas"/>
-        <UnitName Value="fcl.events"/>
-      </Item5>
-      <Item6>
-        <Filename Value="fresnel.events.pas"/>
-        <UnitName Value="fresnel.events"/>
-      </Item6>
-      <Item7>
-        <Filename Value="lcl/fresnel.lclcontrols.pas"/>
-        <UnitName Value="Fresnel.LCLControls"/>
-      </Item7>
-      <Item8>
-        <Filename Value="lcl/fresnel.lclevents.pp"/>
-        <UnitName Value="Fresnel.LCLEvents"/>
-      </Item8>
+    <Description Value="Fresnel framework for standalone applications.
+The skia backend requires the sk4d library, e.g. sk4d.dll for Windows. A version is included with Fresnel in the bin folder."/>
+    <License Value="Modified LGPL-2."/>
+    <Version Minor="3"/>
+    <Files>
+      <Item>
+        <Filename Value="gtk3/fresnel.gtk3.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="fresnel.gtk3"/>
+      </Item>
+      <Item>
+        <Filename Value="fresnel.pas"/>
+        <UnitName Value="Fresnel"/>
+      </Item>
+      <Item>
+        <Filename Value="fresnel.fresnelall.pas"/>
+        <Type Value="Main Unit"/>
+        <UnitName Value="fresnel.fresnelall"/>
+      </Item>
+      <Item>
+        <Filename Value="skia/fresnel.skiarenderer.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="fresnel.skiarenderer"/>
+      </Item>
+      <Item>
+        <Filename Value="skia/skia4delphi/System.Skia.API.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="System.Skia.API"/>
+      </Item>
+      <Item>
+        <Filename Value="skia/skia4delphi/System.Skia.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="System.Skia"/>
+      </Item>
     </Files>
-    <CompatibilityMode Value="True"/>
-    <RequiredPkgs Count="1">
-      <Item1>
-        <PackageName Value="LCL"/>
-      </Item1>
+    <RequiredPkgs>
+      <Item>
+        <PackageName Value="FresnelBase"/>
+      </Item>
     </RequiredPkgs>
     <UsageOptions>
-      <CustomOptions Value="-dFresnel -dFresnel$(FresnelBackend)"/>
+      <CustomOptions Value="-dFresnel -dFresnel$(FresnelBackend) -dFresnel$(FresnelRenderer)"/>
       <UnitPath Value="$(PkgOutDir)"/>
     </UsageOptions>
     <PublishOptions>

src/fresnel.pas

@@ -1,22 +1,25 @@
-{ This file was automatically created by Lazarus. Do not edit!
-  This source is only used to compile and install the package.
- }
-
 unit Fresnel;
 
-{$warn 5023 off : no warning about unused units}
 interface
 
 uses
-  Fresnel.Controls, Fresnel.DOM, Fresnel.Layouter, Fresnel.LCLControls, Fresnel.Renderer, fresnel.lclevents, fcl.events, 
-  fresnel.events, LazarusPackageIntf;
+  Classes, Fresnel.Forms, Fresnel.App,
+  {$IFDEF FresnelCocoa}
+  Fresnel.Cocoa
+  {$ENDIF}
+  {$IFDEF FresnelGtk3}
+  Fresnel.Gtk3
+  {$ENDIF}
+  {$IFDEF FresnelWinApi}
+  Fresnel.WinApi
+  {$ENDIF}
+  ;
 
 implementation
 
-procedure Register;
-begin
-end;
-
 initialization
-  RegisterPackage('Fresnel', @Register);
+  Application:=TApplication.Create(nil);
+finalization
+  Application.Free; // will nil itself
+
 end.

src/fresnel.renderer.pas

@@ -1,194 +0,0 @@
-unit Fresnel.Renderer;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, Math, FPImage, Fresnel.DOM, Fresnel.Controls,
-  Fresnel.Layouter, LazLoggerBase;
-
-type
-
-  { TFresnelRenderer }
-
-  TFresnelRenderer = class(TComponent)
-  private
-    FSubPixel: boolean;
-  protected
-    FOrigin: TFresnelPoint;
-    procedure FillRect(const aColor: TFPColor; const aRect: TFresnelRect); virtual; abstract;
-    procedure Line(const aColor: TFPColor; const x1, y1, x2, y2: TFresnelLength); virtual; abstract;
-    procedure TextOut(const aLeft, aTop: TFresnelLength; const aFont: IFresnelFont; const aColor: TFPColor; const aText: string); virtual; abstract;
-    procedure MathRoundRect(var r: TFresnelRect);
-    procedure DrawElement(El: TFresnelElement); virtual;
-    procedure UpdateRenderedAttributes(El: TFresnelElement); virtual;
-    procedure SetOrigin(const AValue: TFresnelPoint);
-  public
-    procedure Draw(Viewport: TFresnelViewport); virtual;
-    property SubPixel: boolean read FSubPixel write FSubPixel;
-    property Origin: TFresnelPoint read FOrigin write SetOrigin;
-  end;
-
-implementation
-
-{ TFresnelRenderer }
-
-procedure TFresnelRenderer.SetOrigin(const AValue: TFresnelPoint);
-begin
-  if CompareFresnelPoint(FOrigin,AValue)=0 then Exit;
-  FOrigin:=AValue;
-end;
-
-procedure TFresnelRenderer.MathRoundRect(var r: TFresnelRect);
-begin
-  r.Left:=round(r.Left);
-  r.Right:=round(r.Right);
-  r.Top:=round(r.Top);
-  r.Bottom:=round(r.Bottom);
-end;
-
-procedure TFresnelRenderer.DrawElement(El: TFresnelElement);
-var
-  LNode: TSimpleFresnelLayoutNode;
-  aBackgroundColor, aBorderColor, aCaption, aColor: String;
-  aBackgroundColorFP, aBorderColorFP, aColorFP: TFPColor;
-  aLeft, aTop, aRight, aBottom,
-    aMarginLeft, aMarginTop, aMarginRight, aMarginBottom,
-    aBorderLeft, aBorderRight, aBorderTop, aBorderBottom,
-    aPaddingLeft, aPaddingRight, aPaddingTop, aPaddingBottom: TFresnelLength;
-  aBorderBox, aContentBox: TFresnelRect;
-  i: Integer;
-  OldOrigin: TFresnelPoint;
-  VP: TFresnelViewport;
-begin
-  //DebugLn(['TFresnelRenderer.DrawElement ',El.GetPath,' Origin=',dbgs(Origin)]);
-  LNode:=TSimpleFresnelLayoutNode(El.LayoutNode);
-  if LNode.SkipRendering then exit;
-
-  El.Rendered:=true;
-  if (El is TFresnelViewport) then
-  begin
-    aLeft:=0;
-    aTop:=0;
-    VP:=TFresnelViewport(El);
-    aContentBox.Left:=0;
-    aContentBox.Top:=0;
-    aContentBox.Right:=Vp.Width;
-    aContentBox.Bottom:=Vp.Height;
-    El.RenderedBorderBox:=aContentBox;
-    El.RenderedContentBox:=aContentBox;
-  end else begin
-    aLeft:=El.GetRenderedCSSLength(fcaLeft,false);
-    aTop:=El.GetRenderedCSSLength(fcaTop,false);
-    aRight:=El.GetRenderedCSSLength(fcaRight,false);
-    aBottom:=El.GetRenderedCSSLength(fcaBottom,false);
-
-    aMarginLeft:=El.GetRenderedCSSLength(fcaMarginLeft,false);
-    aMarginRight:=El.GetRenderedCSSLength(fcaMarginRight,false);
-    aMarginTop:=El.GetRenderedCSSLength(fcaMarginTop,false);
-    aMarginBottom:=El.GetRenderedCSSLength(fcaMarginBottom,false);
-
-    aBorderLeft:=El.GetRenderedCSSLength(fcaBorderLeftWidth,false);
-    aBorderRight:=El.GetRenderedCSSLength(fcaBorderRightWidth,false);
-    aBorderTop:=El.GetRenderedCSSLength(fcaBorderTopWidth,false);
-    aBorderBottom:=El.GetRenderedCSSLength(fcaBorderBottomWidth,false);
-
-    aPaddingLeft:=El.GetRenderedCSSLength(fcaPaddingLeft,false);
-    aPaddingRight:=El.GetRenderedCSSLength(fcaPaddingRight,false);
-    aPaddingTop:=El.GetRenderedCSSLength(fcaPaddingTop,false);
-    aPaddingBottom:=El.GetRenderedCSSLength(fcaPaddingBottom,false);
-
-    aBorderBox.Left:=aLeft+aMarginLeft;
-    aBorderBox.Top:=aTop+aMarginTop;
-    aBorderBox.Right:=aRight-aMarginRight;
-    aBorderBox.Bottom:=aBottom-aMarginBottom;
-    El.RenderedBorderBox:=aBorderBox;
-    if not SubPixel then
-      MathRoundRect(aBorderBox);
-
-    aContentBox.Left:=aLeft+aMarginLeft+aBorderLeft+aPaddingLeft;
-    aContentBox.Top:=aTop+aMarginTop+aBorderTop+aPaddingTop;
-    aContentBox.Right:=aRight-aMarginRight-aBorderRight-aPaddingRight;
-    aContentBox.Bottom:=aBottom-aMarginBottom-aBorderBottom-aPaddingBottom;
-    El.RenderedContentBox:=aContentBox;
-    if not SubPixel then
-      MathRoundRect(aContentBox);
-
-    //DebugLn(['TFresnelRenderer.DrawElement ',El.Name,' Border=',dbgs(aBorderBox),' Content=',dbgs(aContentBox)]);
-
-    aBackgroundColor:=El.CSSRenderedAttribute[fcaBackgroundColor];
-    if not CSSToFPColor(aBackgroundColor,aBackgroundColorFP) then
-      aBackgroundColorFP:=colTransparent;
-    if aBackgroundColorFP.Alpha<>alphaTransparent then
-    begin
-      FillRect(aBackgroundColorFP,aBorderBox);
-    end;
-
-    aBorderColor:=El.CSSRenderedAttribute[fcaBorderColor];
-    if not CSSToFPColor(aBorderColor,aBorderColorFP) then
-      aBorderColorFP:=colTransparent;
-    if aBorderColorFP.Alpha<>alphaTransparent then
-    begin
-      //debugln(['TFresnelRenderer.DrawElement drawing border ',El.Name]);
-      // left border
-      for i:=0 to Ceil(aBorderLeft)-1 do
-        Line(aBorderColorFP,aBorderBox.Left+i,aBorderBox.Top,aBorderBox.Left+i,aBorderBox.Bottom);
-      // right border
-      for i:=0 to ceil(aBorderRight)-1 do
-        Line(aBorderColorFP,aBorderBox.Right-i,aBorderBox.Top,aBorderBox.Right-i,aBorderBox.Bottom);
-      // top border
-      for i:=0 to ceil(aBorderTop)-1 do
-        Line(aBorderColorFP,aBorderBox.Left,aBorderBox.Top+i,aBorderBox.Right,aBorderBox.Top+i);
-      // bottom border
-      for i:=0 to ceil(aBorderBottom)-1 do
-        Line(aBorderColorFP,aBorderBox.Left,aBorderBox.Bottom-i,aBorderBox.Right,aBorderBox.Bottom-i);
-    end;
-
-    if El is TCustomLabel then
-    begin
-      aCaption:=TCustomLabel(El).RenderedCaption;
-      if aCaption<>'' then
-      begin
-        aColor:=El.GetRenderedCSString(fcaColor,true);
-        if not CSSToFPColor(aColor,aColorFP) then
-          aColorFP:=colTransparent;
-        if aColorFP.Alpha<>alphaTransparent then
-        begin
-          TextOut(aContentBox.Left,aContentBox.Top,El.Font,aColorFP,aCaption);
-        end;
-      end;
-    end;
-  end;
-
-  OldOrigin:=Origin;
-  Origin:=OldOrigin+El.RenderedContentBox.TopLeft;
-  for i:=0 to LNode.NodeCount-1 do
-  begin
-    DrawElement(TSimpleFresnelLayoutNode(LNode.Nodes[i]).Element);
-  end;
-  Origin:=OldOrigin;
-end;
-
-procedure TFresnelRenderer.UpdateRenderedAttributes(El: TFresnelElement);
-var
-  LNode: TSimpleFresnelLayoutNode;
-  i: Integer;
-begin
-  LNode:=TSimpleFresnelLayoutNode(El.LayoutNode);
-  if LNode.SkipRendering then exit;
-
-  El.UpdateRenderedAttributes;
-  for i:=0 to LNode.NodeCount-1 do
-    UpdateRenderedAttributes(TSimpleFresnelLayoutNode(LNode.Nodes[i]).Element);
-end;
-
-procedure TFresnelRenderer.Draw(Viewport: TFresnelViewport);
-begin
-  //debugln(['TFresnelRenderer.Draw Origin=',dbgs(Origin)]);
-  UpdateRenderedAttributes(Viewport);
-  DrawElement(Viewport);
-end;
-
-end.
-

src/gtk3/fresnel.gtk3.pas

@@ -0,0 +1,640 @@
+unit Fresnel.Gtk3;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Math, Types, Classes, BaseUnix, Unix, sysutils, System.UITypes,
+  // lazutils
+  LazLoggerBase,
+  // gtk3
+  LazGtk3, LazGObject2, LazGLib2, LazGio2, Lazcairo1, LazGdk3,
+  {$IFDEF FresnelSkia}
+  // skia
+  System.Skia, Fresnel.SkiaRenderer,
+  {$ENDIF}
+  // fresnel
+  Fresnel.Classes, Fresnel.Forms, Fresnel.WidgetSet, Fresnel.DOM;
+
+type
+  {$IFDEF FresnelSkia}
+  TGtk3FontEngine = TFresnelSkiaFontEngine;
+  TGtk3Renderer = TFresnelSkiaRenderer;
+  {$ENDIF}
+
+  { TGtk3WSForm }
+
+  TGtk3WSForm = class(TFresnelWSForm)
+  private
+    FClientRect: TRect;
+    FForm: TCustomFresnelForm;
+    FWindow: PGtkWindow;
+    procedure SetForm(const AValue: TCustomFresnelForm);
+  protected
+    procedure Notification(AComponent: TComponent; Operation: TOperation);
+      override;
+    function GetFormBounds: TFresnelRect; override;
+    function GetCaption: TFresnelCaption; override;
+    function GetVisible: boolean; override;
+    procedure SetFormBounds(const AValue: TFresnelRect); override;
+    procedure SetCaption(AValue: TFresnelCaption); override;
+    procedure SetVisible(const AValue: boolean); override;
+  public
+    function GetClientSize: TFresnelPoint; override;
+    function GtkEventDraw(AContext: Pcairo_t): Boolean; virtual;
+    function GtkEventKeyDown(Event: PGdkEvent): Boolean; virtual;
+    function GtkEventKeyUp(Event: PGdkEvent): Boolean; virtual;
+    function GtkEventMouseDown(Event: PGdkEvent): Boolean; virtual;
+    function GtkEventMouseEnter(Event: PGdkEvent): Boolean; virtual;
+    function GtkEventMouseLeave(Event: PGdkEvent): Boolean; virtual;
+    function GtkEventMouseMove(Event: PGdkEvent): Boolean; virtual;
+    function GtkEventMouseUp(Event: PGdkEvent): Boolean; virtual;
+    function GtkEvent_Event(Event: PGdkEvent): Boolean; virtual;
+    procedure GtkEventDestroy; virtual;
+    procedure GtkEventHide; virtual;
+    procedure GtkEventMap; virtual;
+    procedure GtkEventShow; virtual;
+    procedure GtkEventSizeAllocate(aRect: PGdkRectangle); virtual;
+    procedure Invalidate; override;
+    procedure InvalidateRect(const aRect: TFresnelRect); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    function CreateGtkWindow: PGtkWindow; virtual;
+    function GetWindowState: TGdkWindowState; virtual;
+    property Window: PGtkWindow read FWindow;
+
+    property Form: TCustomFresnelForm read FForm write SetForm;
+  end;
+
+  { TGtk3WidgetSet }
+
+  TGtk3WidgetSet = class(TFresnelWidgetSet)
+  private
+    FFontEngine: TGtk3FontEngine;
+    FGtk3Application: PGtkApplication;
+  protected
+    procedure InitSynchronizeSupport; virtual;
+    procedure PrepareSynchronize({%H-}AObject: TObject); virtual;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure AppWaitMessage; override;
+    procedure AppProcessMessages; override;
+    procedure AppTerminate; override;
+    procedure AppSetTitle(const ATitle: string); override;
+
+    procedure CreateWSForm(aFresnelForm: TFresnelComponent); override;
+    property Gtk3Application: PGtkApplication read FGtk3Application;
+    property FontEngineGtk3: TGtk3FontEngine read FFontEngine;
+  end;
+
+var
+  Gtk3WidgetSet: TGtk3WidgetSet;
+
+function RectFromGdkRect(const AGdkRect: TGdkRectangle): TRect;
+function FresnelRectFromGdkRect(const AGdkRect: TGdkRectangle): TFresnelRect;
+function GdkRectFromRect(const R: TRect): TGdkRectangle;
+function GdkRectFromFresnelRect(const R: TFresnelRect): TGdkRectangle;
+
+implementation
+
+var
+  ThreadSync_PipeIn, ThreadSync_PipeOut: cint;
+  ThreadSync_GIOChannel: PGIOChannel;
+
+function ThreadSync_IOCallback({%H-}Source: PGIOChannel; {%H-}Condition: TGIOCondition;
+  {%H-}Data: gpointer): gboolean; cdecl;
+var
+  ThrashSpace: array[1..1024] of byte;
+begin
+  // read the sent bytes
+  FpRead(ThreadSync_PipeIn, {%H-}ThrashSpace[1], 1);
+
+  // execute the to-be synchronized method
+  if IsMultiThread then
+    CheckSynchronize;
+
+  Result := true;
+end;
+
+procedure Gtk3WidgetDestroy(AWidget: PGtkWidget; Data: gpointer); cdecl;
+var
+  aForm: TGtk3WSForm;
+begin
+  if AWidget=nil then ;
+  if Data = nil then exit;
+  aForm := TGtk3WSForm(Data);
+  aForm.GtkEventDestroy;
+end;
+
+function Gtk3DrawWidget(AWidget: PGtkWidget; AContext: Pcairo_t; Data: gpointer): gboolean; cdecl;
+var
+  aForm: TGtk3WSForm;
+begin
+  Result := False;
+  if AWidget=nil then ;
+  if Data = nil then exit;
+  aForm := TGtk3WSForm(Data);
+  Result := aForm.GtkEventDraw(AContext);
+end;
+
+function Gtk3WidgetEvent(AWidget: PGtkWidget; Event: PGdkEvent; Data: gpointer): gboolean; cdecl;
+var
+  aForm: TGtk3WSForm;
+begin
+  Result := False;
+  if AWidget=nil then ;
+  if Data = nil then exit;
+  aForm := TGtk3WSForm(Data);
+  Result := aForm.GtkEvent_Event(Event);
+end;
+
+procedure Gtk3WidgetHide({%H-}AWidget: PGtkWidget; Data: gpointer); cdecl;
+var
+  aForm: TGtk3WSForm;
+begin
+  if AWidget=nil then ;
+  if Data = nil then exit;
+  aForm := TGtk3WSForm(Data);
+  aForm.GtkEventHide;
+end;
+
+procedure Gtk3WidgetMap({%H-}AWidget: PGtkWidget; Data: gpointer); cdecl;
+var
+  aForm: TGtk3WSForm;
+begin
+  if AWidget=nil then ;
+  if Data = nil then exit;
+  aForm := TGtk3WSForm(Data);
+  aForm.GtkEventMap;
+end;
+
+procedure Gtk3WidgetShow({%H-}AWidget: PGtkWidget; Data: gpointer); cdecl;
+var
+  aForm: TGtk3WSForm;
+begin
+  if AWidget=nil then ;
+  if Data = nil then exit;
+  aForm := TGtk3WSForm(Data);
+  aForm.GtkEventShow;
+end;
+
+procedure Gtk3WidgetSizeAllocate(AWidget: PGtkWidget; AGdkRect: PGdkRectangle; Data: gpointer); cdecl;
+var
+  aForm: TGtk3WSForm;
+begin
+  if AWidget=nil then ;
+  if Data = nil then exit;
+  aForm := TGtk3WSForm(Data);
+  aForm.GtkEventSizeAllocate(AGdkRect);
+end;
+
+function RectFromGdkRect(const AGdkRect: TGdkRectangle): TRect;
+begin
+  with AGdkRect do
+  begin
+    Result.Left := x;
+    Result.Top := y;
+    Result.Right := Width + x;
+    Result.Bottom := Height + y;
+  end;
+end;
+
+function FresnelRectFromGdkRect(const AGdkRect: TGdkRectangle): TFresnelRect;
+begin
+  with AGdkRect do
+  begin
+    Result.Left := x;
+    Result.Top := y;
+    Result.Right := Width + x;
+    Result.Bottom := Height + y;
+  end;
+end;
+
+function GdkRectFromRect(const R: TRect): TGdkRectangle;
+begin
+  with Result do
+  begin
+    x := R.Left;
+    y := R.Top;
+    width := R.Right-R.Left;
+    height := R.Bottom-R.Top;
+  end;
+end;
+
+function GdkRectFromFresnelRect(const R: TFresnelRect): TGdkRectangle;
+begin
+  with Result do
+  begin
+    x := round(R.Left);
+    y := round(R.Top);
+    width := round(R.Right-R.Left);
+    height := round(R.Bottom-R.Top);
+  end;
+end;
+
+{ TGtk3WSForm }
+
+procedure TGtk3WSForm.SetFormBounds(const AValue: TFresnelRect);
+var
+  aRect: TGdkRectangle;
+begin
+  if Window=nil then
+    raise Exception.Create('TGtk3WSForm.SetBoundsRect Window=nil');
+
+  aRect:=GdkRectFromFresnelRect(AValue);
+  Window^.set_allocation(@ARect);
+end;
+
+procedure TGtk3WSForm.SetCaption(AValue: TFresnelCaption);
+begin
+  raise Exception.Create('TGtk3WSForm.SetCaption ToDo');
+end;
+
+constructor TGtk3WSForm.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FRenderer:=TGtk3Renderer.Create(Self);
+end;
+
+destructor TGtk3WSForm.Destroy;
+begin
+  FreeAndNil(FRenderer);
+  inherited Destroy;
+end;
+
+procedure TGtk3WSForm.SetForm(const AValue: TCustomFresnelForm);
+begin
+  if FForm=AValue then Exit;
+  FForm:=AValue;
+  if FForm<>nil then
+    FreeNotification(FForm);
+end;
+
+function TGtk3WSForm.GetVisible: boolean;
+begin
+  Result:=(FWindow^.window<>nil)
+       and gdk_window_is_visible(FWindow^.window);
+end;
+
+procedure TGtk3WSForm.GtkEventDestroy;
+begin
+
+end;
+
+function TGtk3WSForm.GtkEventDraw(AContext: Pcairo_t): Boolean;
+var
+  ARect: TGdkRectangle;
+  W, H: integer;
+  {$IFDEF FresnelSkia}
+  SkiaRenderer: TFresnelSkiaRenderer;
+  SkSurface: ISkSurface;
+  SkCanvas: ISkCanvas;
+  CairoSurface: Pcairo_surface_t;
+  Pixels: Pointer;
+  {$ENDIF}
+begin
+  Result:=true;
+  if FForm=nil then exit;
+
+  gdk_cairo_get_clip_rectangle(AContext, @ARect);
+  DebugLn('TGtk3WSForm.GtkEventDraw ',dbgsName(Self),' clip=',dbgs(RectFromGdkRect(ARect)),' ',DbgSName(Form.Renderer));
+
+  W:=ARect.width;
+  H:=ARect.height;
+  if (W<1) or (H<1) then exit;
+
+  {$IFDEF FresnelSkia}
+  if Form.Renderer is TFresnelSkiaRenderer then
+  begin
+    SkiaRenderer:=TFresnelSkiaRenderer(Form.Renderer);
+    Pixels:=GetMem(W*H*4);
+    try
+      SkSurface := TSkSurface.MakeRasterDirect(TSkImageInfo.Create(W, H), Pixels, W*4);
+      SkCanvas:=SkSurface.Canvas;
+      SkiaRenderer.Canvas:=SkCanvas;
+
+      Form.WSDraw;
+
+      CairoSurface:=cairo_image_surface_create_for_data(Pixels,CAIRO_FORMAT_ARGB32,W,H,W*4);
+      cairo_surface_mark_dirty(CairoSurface);
+      cairo_set_source_surface(AContext,CairoSurface,0,0);
+      cairo_paint(AContext);
+
+    finally
+      SkiaRenderer.Canvas:=nil;
+      FreeMem(Pixels);
+    end;
+  end;
+  {$ENDIF}
+end;
+
+function TGtk3WSForm.GtkEventKeyDown(Event: PGdkEvent): Boolean;
+begin
+  Result:=false;
+end;
+
+function TGtk3WSForm.GtkEventKeyUp(Event: PGdkEvent): Boolean;
+begin
+  Result:=false;
+end;
+
+function TGtk3WSForm.GtkEventMouseDown(Event: PGdkEvent): Boolean;
+begin
+  Result:=false;
+end;
+
+function TGtk3WSForm.GtkEventMouseEnter(Event: PGdkEvent): Boolean;
+begin
+  Result:=false;
+end;
+
+function TGtk3WSForm.GtkEventMouseLeave(Event: PGdkEvent): Boolean;
+begin
+  Result:=false;
+end;
+
+function TGtk3WSForm.GtkEventMouseMove(Event: PGdkEvent): Boolean;
+begin
+  Result:=false;
+end;
+
+function TGtk3WSForm.GtkEventMouseUp(Event: PGdkEvent): Boolean;
+begin
+  Result:=false;
+end;
+
+function TGtk3WSForm.GtkEvent_Event(Event: PGdkEvent): Boolean;
+begin
+  Result:=false; // true if handled
+  case Event^.type_ of
+  GDK_MOTION_NOTIFY:
+    Result := GtkEventMouseMove(Event);
+  GDK_BUTTON_PRESS,
+  GDK_DOUBLE_BUTTON_PRESS,
+  GDK_TRIPLE_BUTTON_PRESS:
+    Result := GtkEventMouseDown(Event);
+  GDK_BUTTON_RELEASE:
+    Result := GtkEventMouseUp(Event);
+  GDK_KEY_PRESS:
+    Result := GtkEventKeyDown(Event);
+  GDK_KEY_RELEASE:
+    Result := GtkEventKeyUp(Event);
+  GDK_ENTER_NOTIFY:
+    Result := GtkEventMouseEnter(Event);
+  GDK_LEAVE_NOTIFY:
+    Result := GtkEventMouseLeave(Event);
+  GDK_FOCUS_CHANGE:
+    debugln(['TSkiaGtk3WSForm.GtkEvent_Event GDK_FOCUS_CHANGE ',DbgSName(Self)]);
+  GDK_CONFIGURE:
+    ; //Result := GtkEventResize(Event);
+  GDK_VISIBILITY_NOTIFY:
+    debugln(['TSkiaGtk3WSForm.GtkEvent_Event GDK_VISIBILITY_NOTIFY ',DbgSName(Self)]);
+  end;
+end;
+
+procedure TGtk3WSForm.GtkEventHide;
+begin
+
+end;
+
+procedure TGtk3WSForm.GtkEventMap;
+begin
+
+end;
+
+procedure TGtk3WSForm.GtkEventShow;
+begin
+
+end;
+
+procedure TGtk3WSForm.GtkEventSizeAllocate(aRect: PGdkRectangle);
+var
+  FreRect: TFresnelRect;
+begin
+  // aRect is the inner rect (at 0,0 and without frame and title)
+  if aRect=nil then ;
+  FClientRect:=RectFromGdkRect(aRect^);
+
+  // retrieve the current window
+  FreRect:=GetFormBounds;
+  //debugln(['TGtk3WSForm.GtkEventSizeAllocate ',DbgSName(Form),' ',dbgs(FreRect),' Allocate=',aRect^.width,',',aRect^.height]);
+  Form.WSResize(FreRect,FClientRect.Right,FClientRect.Bottom);
+end;
+
+procedure TGtk3WSForm.Invalidate;
+begin
+  FWindow^.queue_draw;
+end;
+
+procedure TGtk3WSForm.InvalidateRect(const aRect: TFresnelRect);
+begin
+  FWindow^.queue_draw_area(
+    floor(aRect.Left),
+    floor(aRect.Top),
+    ceil(aRect.Width),
+    ceil(aRect.Height));
+end;
+
+procedure TGtk3WSForm.Notification(AComponent: TComponent; Operation: TOperation
+  );
+begin
+  inherited Notification(AComponent, Operation);
+  if Operation=opRemove then
+  begin
+    if FForm=AComponent then
+      FForm:=nil;
+  end;
+end;
+
+function TGtk3WSForm.GetFormBounds: TFresnelRect;
+var
+  ARect: TGdkRectangle;
+begin
+  gtk_window_get_position(Window,@ARect.x,@ARect.y);
+  gtk_window_get_size(Window,@ARect.width,@ARect.height);
+  Result:=FresnelRectFromGdkRect(ARect);
+end;
+
+function TGtk3WSForm.GetCaption: TFresnelCaption;
+begin
+  Result:='';
+  raise Exception.Create('TGtk3WSForm.GetCaption ToDo');
+end;
+
+procedure TGtk3WSForm.SetVisible(const AValue: boolean);
+begin
+  debugln(['TGtk3WSForm.SetVisible ',DbgSName(Form),' AValue=',AValue]);
+  if FWindow=nil then
+    raise Exception.Create('TGtk3WSForm.SetVisible Window=nil');
+  if AValue then
+    FWindow^.show
+  else
+    FWindow^.hide;
+end;
+
+function TGtk3WSForm.GetClientSize: TFresnelPoint;
+begin
+  Result.X:=FClientRect.Right;
+  Result.Y:=FClientRect.Bottom;
+end;
+
+function TGtk3WSForm.CreateGtkWindow: PGtkWindow;
+var
+  ARect: TGdkRectangle;
+begin
+  debugln(['TGtk3WSForm.CreateGtkWindow Bounds=',dbgs(Form.FormBounds)]);
+  FWindow := TGtkWindow.new(GTK_WINDOW_TOPLEVEL);
+  Result:=Window;
+
+  g_signal_connect_data(Window,'destroy', TGCallback(@Gtk3WidgetDestroy), Self, nil, G_CONNECT_DEFAULT);
+  g_signal_connect_data(Window,'draw', TGCallback(@Gtk3DrawWidget), Self, nil, G_CONNECT_DEFAULT);
+  g_signal_connect_data(Window,'event', TGCallback(@Gtk3WidgetEvent), Self, nil, G_CONNECT_DEFAULT);
+  g_signal_connect_data(Window,'hide', TGCallback(@Gtk3WidgetHide), Self, nil, G_CONNECT_DEFAULT);
+  g_signal_connect_data(Window,'map', TGCallback(@Gtk3WidgetMap), Self, nil, G_CONNECT_DEFAULT);
+  g_signal_connect_data(Window,'show', TGCallback(@Gtk3WidgetShow), Self, nil, G_CONNECT_DEFAULT);
+  g_signal_connect_data(Window,'size-allocate',TGCallback(@Gtk3WidgetSizeAllocate), Self, nil, G_CONNECT_DEFAULT);
+
+  aRect:=GdkRectFromFresnelRect(Form.FormBounds);
+  //Window^.set_allocation(@ARect);
+  gtk_window_move(Window,aRect.x,aRect.y);
+  gtk_window_resize(Window,aRect.width,aRect.height);
+  FClientRect.Right:=Window^.get_allocated_width;
+  FClientRect.Bottom:=Window^.get_allocated_height;
+end;
+
+function TGtk3WSForm.GetWindowState: TGdkWindowState;
+begin
+  if (Window<>nil) and (Window^.window<>nil) then
+    Result:=Window^.window^.get_state
+  else
+    Result:=[];
+end;
+
+procedure TGtk3WidgetSet.InitSynchronizeSupport;
+begin
+  WakeMainThread := @PrepareSynchronize;
+  AssignPipe(ThreadSync_PipeIn, ThreadSync_PipeOut);
+  ThreadSync_GIOChannel := g_io_channel_unix_new(ThreadSync_PipeIn);
+  g_io_add_watch(ThreadSync_GIOChannel, [G_IO_IN], @ThreadSync_IOCallback, Self);
+end;
+
+procedure TGtk3WidgetSet.PrepareSynchronize(AObject: TObject);
+var
+  {%H-}thrash: char;
+begin
+  // wake up GUI thread by sending a byte through the threadsync pipe
+  thrash:='l';
+  fpwrite(ThreadSync_PipeOut, thrash, 1);
+end;
+
+constructor TGtk3WidgetSet.Create(AOwner: TComponent);
+var
+  AGtkThread: PGThread;
+  AId: String;
+begin
+  inherited Create(AOwner);
+
+  Gtk3WidgetSet:=Self;
+  SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
+  FWSFormClass:=TGtk3WSForm;
+
+  g_type_init;
+  gtk_init(@argc, @argv);
+
+  if not IsLibrary then
+  begin
+    AGtkThread := g_thread_self();
+    AId := 'org.fresnelskiagtk3.thread_' + dbghex({%H-}PtrUInt(AGtkThread));
+    FGtk3Application := TGtkApplication.new(PgChar(AId), [G_APPLICATION_NON_UNIQUE]);
+    FGtk3Application^.register(nil, nil);
+  end;
+
+  {$IFDEF UNIX}
+  InitSynchronizeSupport;
+  {$ELSE}
+  //WakeMainThread := @DoWakeMainThread;
+  {$ENDIF}
+
+  FFontEngine:=TGtk3FontEngine.Create(nil);
+  TFresnelFontEngine.WSEngine:=FFontEngine;
+end;
+
+destructor TGtk3WidgetSet.Destroy;
+begin
+  TFresnelFontEngine.WSEngine:=nil;
+  FreeAndNil(FFontEngine);
+  Gtk3WidgetSet:=nil;
+  inherited Destroy;
+end;
+
+procedure TGtk3WidgetSet.AppWaitMessage;
+begin
+  gtk_main_iteration;
+end;
+
+procedure TGtk3WidgetSet.AppProcessMessages;
+begin
+  while gtk_events_pending do
+    gtk_main_iteration_do(False);
+end;
+
+procedure TGtk3WidgetSet.AppTerminate;
+var
+  AList: PGList;
+begin
+  if Assigned(FGtk3Application) then
+  begin
+    FGtk3Application^.quit;
+    AList := FGtk3Application^.get_windows;
+    if Assigned(AList) then
+    begin
+      {$IFDEF VerboseGTK3}
+      DebugLn('TSkiaGtk3App.AppTerminate Windows list ',dbgs(g_list_length(AList)));
+      {$ENDIF}
+      g_list_free(AList);
+    end else
+    begin
+      {$IFDEF VerboseGTK3}
+      DebugLn('TSkiaGtk3App.AppTerminate Windows list is null ');
+      {$ENDIF}
+    end;
+    FGtk3Application^.release;
+    FGtk3Application^.unref;
+    FGtk3Application := nil;
+  end;
+  if gtk_main_level > 0 then
+    gtk_main_quit;
+end;
+
+procedure TGtk3WidgetSet.AppSetTitle(const ATitle: string);
+begin
+  inherited AppSetTitle(ATitle);
+end;
+
+procedure TGtk3WidgetSet.CreateWSForm(aFresnelForm: TFresnelComponent);
+var
+  aForm: TCustomFresnelForm;
+  aWSForm: TGtk3WSForm;
+begin
+  if not (aFresnelForm is TCustomFresnelForm) then
+    raise Exception.Create('TGtk3WidgetSet.CreateWSForm '+DbgSName(aFresnelForm));
+  aForm:=TCustomFresnelForm(aFresnelForm);
+  aForm.FontEngine:=FontEngineGtk3;
+
+  aWSForm:=TGtk3WSForm.Create(aForm);
+  aWSForm.Form:=aForm;
+  aForm.WSForm:=aWSForm;
+  aWSForm.CreateGtkWindow;
+end;
+
+initialization
+  TGtk3WidgetSet.Create(nil);
+finalization
+  Gtk3WidgetSet.Free; // it will nil itself
+
+end.
+

src/lcl/fresnel.lcl.pas

@@ -0,0 +1,644 @@
+{
+  The Fresnel-LCL widgetset and renderer.
+}
+unit Fresnel.LCL;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Types, Math, FPImage,
+  AvgLvlTree, LazLoggerBase,
+  Graphics, Controls, LCLIntf, Forms, LCLStrConsts, LResources,
+  Fresnel.Classes, Fresnel.Events, Fresnel.DOM, Fresnel.Layouter,
+  Fresnel.Renderer, Fresnel.WidgetSet, Fresnel.Forms;
+
+type
+  TFresnelLCLFontEngine = class;
+
+  { TFresnelLCLFont }
+
+  TFresnelLCLFont = class(TInterfacedObject,IFresnelFont)
+  public
+    Engine: TFresnelLCLFontEngine;
+    Family: string;
+    Kerning: string;
+    Size: string;
+    Style: string;
+    Variant_: string;
+    Weight: string;
+    LCLFont: TFont;
+    destructor Destroy; override;
+    function GetFamily: string;
+    function GetKerning: string;
+    function GetSize: string;
+    function GetStyle: string;
+    function GetVariant: string;
+    function GetWeight: string;
+    function TextSize(const aText: string): TFresnelPoint; virtual;
+    function TextSizeMaxWidth(const aText: string; MaxWidth: TFresnelLength
+      ): TFresnelPoint; virtual;
+    function GetTool: TObject;
+  end;
+
+  { TFresnelLCLFontEngine }
+
+  TFresnelLCLFontEngine = class(TFresnelFontEngine)
+  private
+    FCanvas: TCanvas;
+    FFonts: TAvgLvlTree; // tree of TFresnelLCLFont sorted with CompareFresnelLCLFont
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    function FindFont(const Desc: TFresnelFontDesc): TFresnelLCLFont; virtual;
+    function Allocate(const Desc: TFresnelFontDesc): IFresnelFont; override;
+    function TextSize(aFont: TFresnelLCLFont; const aText: string): TPoint; virtual;
+    function TextSizeMaxWidth(aFont: TFresnelLCLFont; const aText: string; MaxWidth: integer): TPoint; virtual;
+    function NeedLCLFont(aFont: TFresnelLCLFont): TFont; virtual;
+    property Canvas: TCanvas read FCanvas write FCanvas;
+  end;
+
+  { TFresnelLCLRenderer }
+
+  TFresnelLCLRenderer = class(TFresnelRenderer)
+  private
+    FCanvas: TCanvas;
+  protected
+    procedure FillRect(const aColor: TFPColor; const aRect: TFresnelRect); override;
+    procedure Line(const aColor: TFPColor; const x1, y1, x2, y2: TFresnelLength); override;
+    procedure TextOut(const aLeft, aTop: TFresnelLength;
+      const aFont: IFresnelFont; const aColor: TFPColor;
+      const aText: string); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    property Canvas: TCanvas read FCanvas write FCanvas;
+  end;
+
+  TLCLWSForm = class;
+
+  { TFresnelLCLForm }
+
+  TFresnelLCLForm = class(TForm)
+  private
+    FFresnelForm: TCustomFresnelForm;
+  public
+    property FresnelForm: TCustomFresnelForm read FFresnelForm;
+  end;
+
+  { TLCLWSForm }
+
+  TLCLWSForm = class(TFresnelWSForm)
+  private
+    FFresnelForm: TCustomFresnelForm;
+    FLCLForm: TFresnelLCLForm;
+    procedure InitMouseXYEvent(out EvtInit: TFresnelMouseEventInit;
+      Shift: TShiftState; X, Y: Integer;
+      Button: Controls.TMouseButton = Controls.mbLeft);
+    procedure LCLMouseDown(Sender: TObject; Button: Controls.TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure LCLMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+    procedure LCLMouseUp(Sender: TObject; Button: Controls.TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure LCLPaint(Sender: TObject);
+    procedure SetFresnelForm(const AValue: TCustomFresnelForm);
+  protected
+    function GetCaption: TFresnelCaption; override;
+    function GetFormBounds: TFresnelRect; override;
+    function GetVisible: boolean; override;
+    procedure Notification(AComponent: TComponent; Operation: TOperation);
+      override;
+    procedure SetCaption(AValue: TFresnelCaption); override;
+    procedure SetFormBounds(const AValue: TFresnelRect); override;
+    procedure SetVisible(const AValue: boolean); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    function GetClientSize: TFresnelPoint; override;
+    procedure Invalidate; override;
+    procedure InvalidateRect(const aRect: TFresnelRect); override;
+    function CreateLCLForm: TForm; virtual;
+    property LCLForm: TFresnelLCLForm read FLCLForm;
+
+    property FresnelForm: TCustomFresnelForm read FFresnelForm write SetFresnelForm;
+  end;
+
+  { TFresnelLCLWidgetSet }
+
+  TFresnelLCLWidgetSet = class(TFresnelWidgetSet)
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    procedure AppProcessMessages; override;
+    procedure AppTerminate; override;
+    procedure AppWaitMessage; override;
+    procedure CreateWSForm(aFresnelForm: TFresnelComponent); override;
+  end;
+
+var
+  FresnelLCLWidgetSet: TFresnelLCLWidgetSet;
+
+function CompareFresnelLCLFont(Item1, Item2: Pointer): integer;
+function CompareFresnelFontDescWithLCLFont(Key, Item: Pointer): integer;
+procedure FresnelRectToRect(const Src: TFresnelRect; out Dest: TRect);
+
+implementation
+
+function CompareFresnelLCLFont(Item1, Item2: Pointer): integer;
+var
+  Font1: TFresnelLCLFont absolute Item1;
+  Font2: TFresnelLCLFont absolute Item2;
+begin
+  Result:=CompareText(Font1.Family,Font2.Family);
+  if Result<>0 then exit;
+  Result:=CompareText(Font1.Size,Font2.Size);
+  if Result<>0 then exit;
+  Result:=CompareText(Font1.Style,Font2.Style);
+  if Result<>0 then exit;
+  Result:=CompareText(Font1.Weight,Font2.Weight);
+  if Result<>0 then exit;
+  Result:=CompareText(Font1.Variant_,Font2.Variant_);
+  if Result<>0 then exit;
+  Result:=CompareText(Font1.Kerning,Font2.Kerning);
+end;
+
+function CompareFresnelFontDescWithLCLFont(Key, Item: Pointer): integer;
+var
+  Desc: PFresnelFontDesc absolute Key;
+  aFont: TFresnelLCLFont absolute Item;
+begin
+  Result:=CompareText(Desc^.Family,aFont.Family);
+  if Result<>0 then exit;
+  Result:=CompareText(Desc^.Size,aFont.Size);
+  if Result<>0 then exit;
+  Result:=CompareText(Desc^.Style,aFont.Style);
+  if Result<>0 then exit;
+  Result:=CompareText(Desc^.Weight,aFont.Weight);
+  if Result<>0 then exit;
+  Result:=CompareText(Desc^.Variant_,aFont.Variant_);
+  if Result<>0 then exit;
+  Result:=CompareText(Desc^.Kerning,aFont.Kerning);
+end;
+
+procedure FresnelRectToRect(const Src: TFresnelRect; out Dest: TRect);
+begin
+  Dest.Left:=floor(Src.Left);
+  Dest.Top:=floor(Src.Top);
+  Dest.Right:=ceil(Src.Right);
+  Dest.Bottom:=ceil(Src.Bottom);
+end;
+
+{ TFresnelLCLRenderer }
+
+procedure TFresnelLCLRenderer.FillRect(const aColor: TFPColor;
+  const aRect: TFresnelRect);
+begin
+  Canvas.Brush.FPColor:=aColor;
+  Canvas.Brush.Style:=bsSolid;
+  Canvas.FillRect(Rect(floor(FOrigin.X+aRect.Left),floor(FOrigin.Y+aRect.Top),
+                       ceil(FOrigin.X+aRect.Right),ceil(FOrigin.Y+aRect.Bottom)));
+end;
+
+procedure TFresnelLCLRenderer.Line(const aColor: TFPColor; const x1, y1, x2,
+  y2: TFresnelLength);
+begin
+  Canvas.Pen.FPColor:=aColor;
+  Canvas.Pen.Style:=psSolid;
+  Canvas.Line(round(FOrigin.X+x1),round(FOrigin.Y+y1),round(FOrigin.X+x2),round(FOrigin.Y+y2));
+end;
+
+procedure TFresnelLCLRenderer.TextOut(const aLeft, aTop: TFresnelLength;
+  const aFont: IFresnelFont; const aColor: TFPColor; const aText: string
+  );
+var
+  ts: TTextStyle;
+  aFresnelFont: TFresnelLCLFont;
+begin
+  aFresnelFont:=aFont.GetTool as TFresnelLCLFont;
+  Canvas.Font:=aFresnelFont.LCLFont;
+  Canvas.Font.FPColor:=aColor;
+  ts:=Canvas.TextStyle;
+  ts.Opaque:=false;
+  Canvas.TextStyle:=ts;
+  Canvas.TextOut(round(FOrigin.X+aLeft),round(FOrigin.Y+aTop),aText);
+end;
+
+constructor TFresnelLCLRenderer.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+end;
+
+{ TLCLWSForm }
+
+procedure TLCLWSForm.SetFresnelForm(const AValue: TCustomFresnelForm);
+begin
+  if FFresnelForm=AValue then Exit;
+  FFresnelForm:=AValue;
+  if FFresnelForm<>nil then
+    FreeNotification(FFresnelForm);
+end;
+
+procedure TLCLWSForm.InitMouseXYEvent(out EvtInit: TFresnelMouseEventInit;
+  Shift: TShiftState; X, Y: Integer; Button: Controls.TMouseButton);
+begin
+  EvtInit:=Default(TFresnelMouseEventInit);
+
+  case Button of
+    mbLeft: EvtInit.Button:=Fresnel.Events.TMouseButton.mbMain;
+    mbRight: EvtInit.Button:=Fresnel.Events.TMouseButton.mbSecond;
+    mbMiddle: EvtInit.Button:=Fresnel.Events.TMouseButton.mbAux;
+    mbExtra1: EvtInit.Button:=Fresnel.Events.TMouseButton.mbFourth;
+    mbExtra2: EvtInit.Button:=Fresnel.Events.TMouseButton.mbFifth;
+  end;
+
+  if ssLeft in Shift then
+    Include(EvtInit.Buttons,Fresnel.Events.TMouseButton.mbMain);
+  if ssMiddle in Shift then
+    Include(EvtInit.Buttons,Fresnel.Events.TMouseButton.mbAux);
+  if ssRight in Shift then
+    Include(EvtInit.Buttons,Fresnel.Events.TMouseButton.mbSecond);
+  if ssExtra1 in Shift then
+    Include(EvtInit.Buttons,Fresnel.Events.TMouseButton.mbFourth);
+  if ssExtra2 in Shift then
+    Include(EvtInit.Buttons,Fresnel.Events.TMouseButton.mbFifth);
+
+  EvtInit.ScreenPos.SetLocation(Controls.Mouse.CursorPos);
+  EvtInit.PagePos.X:=X;
+  EvtInit.PagePos.Y:=Y;
+  EvtInit.Shiftstate:=Shift;
+end;
+
+procedure TLCLWSForm.LCLMouseDown(Sender: TObject; Button: Controls.TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+var
+  EvtInit: TFresnelMouseEventInit;
+begin
+  InitMouseXYEvent(EvtInit,Shift,X,Y,Button);
+  FresnelForm.WSMouseXY(EvtInit,evtMouseDown);
+end;
+
+procedure TLCLWSForm.LCLMouseMove(Sender: TObject; Shift: TShiftState; X,
+  Y: Integer);
+var
+  EvtInit: TFresnelMouseEventInit;
+begin
+  InitMouseXYEvent(EvtInit,Shift,X,Y);
+  FresnelForm.WSMouseXY(EvtInit,evtMouseMove);
+end;
+
+procedure TLCLWSForm.LCLMouseUp(Sender: TObject; Button: Controls.TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+var
+  EvtInit: TFresnelMouseEventInit;
+begin
+  InitMouseXYEvent(EvtInit,Shift,X,Y,Button);
+  FresnelForm.WSMouseXY(EvtInit,evtMouseUp);
+end;
+
+procedure TLCLWSForm.LCLPaint(Sender: TObject);
+begin
+  FresnelForm.WSDraw;
+end;
+
+function TLCLWSForm.GetFormBounds: TFresnelRect;
+begin
+  Result.SetRect(LCLForm.BoundsRect);
+end;
+
+function TLCLWSForm.GetCaption: TFresnelCaption;
+begin
+  Result:=LCLForm.Caption;
+end;
+
+function TLCLWSForm.GetVisible: boolean;
+begin
+  Result:=LCLForm.Visible;
+end;
+
+procedure TLCLWSForm.Notification(AComponent: TComponent; Operation: TOperation
+  );
+begin
+  inherited Notification(AComponent, Operation);
+  if Operation=opRemove then
+  begin
+    if FFresnelForm=AComponent then
+      FFresnelForm:=nil;
+    if FLCLForm=AComponent then
+      FLCLForm:=nil;
+  end;
+end;
+
+procedure TLCLWSForm.SetFormBounds(const AValue: TFresnelRect);
+begin
+  LCLForm.BoundsRect:=AValue.GetRect;
+end;
+
+procedure TLCLWSForm.SetCaption(AValue: TFresnelCaption);
+begin
+  LCLForm.Caption:=AValue;
+end;
+
+procedure TLCLWSForm.SetVisible(const AValue: boolean);
+begin
+  LCLForm.Visible:=AValue;
+end;
+
+constructor TLCLWSForm.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FRenderer:=TFresnelLCLRenderer.Create(Self);
+end;
+
+destructor TLCLWSForm.Destroy;
+begin
+  FreeAndNil(FRenderer);
+  inherited Destroy;
+end;
+
+function TLCLWSForm.GetClientSize: TFresnelPoint;
+begin
+  Result.X:=LCLForm.ClientWidth;
+  Result.Y:=LCLForm.ClientHeight;
+end;
+
+procedure TLCLWSForm.Invalidate;
+begin
+  LCLForm.Invalidate;
+end;
+
+procedure TLCLWSForm.InvalidateRect(const aRect: TFresnelRect);
+var
+  PixRect: TRect;
+begin
+  PixRect:=aRect.GetRect;
+  LCLIntf.InvalidateRect(LCLForm.Handle,@PixRect,false);
+end;
+
+function TLCLWSForm.CreateLCLForm: TForm;
+var
+  aFontEngine: TFresnelLCLFontEngine;
+begin
+  debugln(['TLCLWSForm.CreateLCLForm Bounds=',dbgs(FresnelForm.FormBounds)]);
+  FLCLForm := TFresnelLCLForm.CreateNew(Self);
+  FLCLForm.FFresnelForm:=FresnelForm;
+  Result:=LCLForm;
+  TFresnelLCLRenderer(FRenderer).Canvas:=LCLForm.Canvas;
+
+  // create one fontengine per form
+  aFontEngine:=TFresnelLCLFontEngine.Create(FLCLForm);
+  FresnelForm.FontEngine:=aFontEngine;
+  aFontEngine.Canvas:=LCLForm.Canvas;
+
+  // events
+  FLCLForm.OnMouseDown:=@LCLMouseDown;
+  FLCLForm.OnMouseMove:=@LCLMouseMove;
+  FLCLForm.OnMouseUp:=@LCLMouseUp;
+  FLCLForm.OnPaint:=@LCLPaint;
+
+  // resize lcl form
+  LCLForm.BoundsRect:=FresnelForm.FormBounds.GetRect;
+end;
+
+{ TFresnelLCLWidgetSet }
+
+constructor TFresnelLCLWidgetSet.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+end;
+
+destructor TFresnelLCLWidgetSet.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TFresnelLCLWidgetSet.AppProcessMessages;
+begin
+  Forms.Application.ProcessMessages;
+end;
+
+procedure TFresnelLCLWidgetSet.AppTerminate;
+begin
+  Forms.Application.Terminate;
+end;
+
+procedure TFresnelLCLWidgetSet.AppWaitMessage;
+begin
+  Forms.Application.Idle(true);
+end;
+
+procedure TFresnelLCLWidgetSet.CreateWSForm(aFresnelForm: TFresnelComponent);
+var
+  aForm: TCustomFresnelForm;
+  aWSForm: TLCLWSForm;
+begin
+  if not (aFresnelForm is TCustomFresnelForm) then
+    raise Exception.Create('TFresnelLCLWidgetSet.CreateWSForm '+DbgSName(aFresnelForm));
+  aForm:=TCustomFresnelForm(aFresnelForm);
+
+  aWSForm:=TLCLWSForm.Create(aForm);
+  aWSForm.FresnelForm:=aForm;
+  aForm.WSForm:=aWSForm;
+  aWSForm.CreateLCLForm;
+end;
+
+{ TFresnelLCLFontEngine }
+
+constructor TFresnelLCLFontEngine.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FFonts:=TAvgLvlTree.Create(@CompareFresnelLCLFont);
+end;
+
+destructor TFresnelLCLFontEngine.Destroy;
+var
+  Node: TAvgLvlTreeNode;
+  aFont: TFresnelLCLFont;
+begin
+  Node:=FFonts.Root;
+  while Node<>nil do
+  begin
+    aFont:=TFresnelLCLFont(Node.Data);
+    Node.Data:=nil;
+    aFont._Release;
+    Node:=Node.Successor;
+  end;
+  FreeAndNil(FFonts);
+  inherited Destroy;
+end;
+
+function TFresnelLCLFontEngine.FindFont(const Desc: TFresnelFontDesc
+  ): TFresnelLCLFont;
+var
+  Node: TAvgLvlTreeNode;
+begin
+  Node:=FFonts.FindKey(@Desc,@CompareFresnelFontDescWithLCLFont);
+  if Node=nil then
+    Result:=nil
+  else
+    Result:=TFresnelLCLFont(Node.Data);
+end;
+
+function TFresnelLCLFontEngine.Allocate(const Desc: TFresnelFontDesc
+  ): IFresnelFont;
+var
+  aFont: TFresnelLCLFont;
+begin
+  aFont:=FindFont(Desc);
+  if aFont<>nil then
+    exit(aFont);
+  aFont:=TFresnelLCLFont.Create;
+  aFont.Engine:=Self;
+  aFont._AddRef;
+  aFont.Family:=Desc.Family;
+  aFont.Kerning:=Desc.Kerning;
+  aFont.Size:=Desc.Size;
+  aFont.Style:=Desc.Style;
+  aFont.Variant_:=Desc.Variant_;
+  aFont.Weight:=Desc.Weight;
+  FFonts.Add(aFont);
+  Result:=aFont;
+end;
+
+function TFresnelLCLFontEngine.TextSize(aFont: TFresnelLCLFont;
+  const aText: string): TPoint;
+var
+  aSize: TSize;
+begin
+  Canvas.Font:=NeedLCLFont(aFont);
+  aSize:=Canvas.TextExtent(aText);
+  Result.X:=aSize.cx;
+  Result.Y:=aSize.cy;
+end;
+
+function TFresnelLCLFontEngine.TextSizeMaxWidth(aFont: TFresnelLCLFont;
+  const aText: string; MaxWidth: integer): TPoint;
+var
+  aSize: TSize;
+begin
+  Canvas.Font:=NeedLCLFont(aFont);
+
+  if LCLIntf.GetTextExtentExPoint(Canvas.Handle, PChar(aText), Length(aText),
+    MaxWidth, nil, nil, aSize) then
+  begin
+    Result.X:=aSize.cx;
+    Result.Y:=aSize.cy;
+  end else begin
+    Result.X:=0;
+    Result.Y:=0;
+  end;
+end;
+
+function TFresnelLCLFontEngine.NeedLCLFont(aFont: TFresnelLCLFont): TFont;
+var
+  aLCLFont: TFont;
+  v: integer;
+  aStyle: TFontStyles;
+begin
+  if aFont.LCLFont=nil then
+  begin
+    aLCLFont:=TFont.Create;
+    aFont.LCLFont:=aLCLFont;
+    case aFont.Size of
+    'xx-small': aLCLFont.Size:=6;
+    'x-small': aLCLFont.Size:=7;
+    'smaller': aLCLFont.Size:=8;
+    'small': aLCLFont.Size:=8;
+    'medium': aLCLFont.Size:=10;
+    'large': aLCLFont.Size:=13;
+    'larger': aLCLFont.Size:=15;
+    'x-large': aLCLFont.Size:=20;
+    'xx-large': aLCLFont.Size:=30;
+    else
+      if TryStrToInt(aFont.Size,v) then
+      begin
+        if v<4 then v:=4;
+        aLCLFont.Size:=v;
+      end;
+    end;
+    aStyle:=[];
+    case aFont.Weight of
+    'bold',
+    'bolder',
+    '500',
+    '600',
+    '700': Include(aStyle,fsBold);
+    end;
+    case aFont.Style of
+    'italic': Include(aStyle,fsItalic);
+    end;
+    aLCLFont.Style:=aStyle;
+  end;
+  Result:=aFont.LCLFont;
+end;
+
+{ TFresnelLCLFont }
+
+destructor TFresnelLCLFont.Destroy;
+begin
+  FreeAndNil(LCLFont);
+  inherited Destroy;
+end;
+
+function TFresnelLCLFont.GetFamily: string;
+begin
+  Result:=Family;
+end;
+
+function TFresnelLCLFont.GetKerning: string;
+begin
+  Result:=Kerning;
+end;
+
+function TFresnelLCLFont.GetSize: string;
+begin
+  Result:=Size;
+end;
+
+function TFresnelLCLFont.GetStyle: string;
+begin
+  Result:=Style;
+end;
+
+function TFresnelLCLFont.GetVariant: string;
+begin
+  Result:=Variant_;
+end;
+
+function TFresnelLCLFont.GetWeight: string;
+begin
+  Result:=Weight;
+end;
+
+function TFresnelLCLFont.TextSize(const aText: string): TFresnelPoint;
+var
+  p: TPoint;
+begin
+  p:=Engine.TextSize(Self,aText);
+  Result.X:=p.X;
+  Result.Y:=p.Y;
+end;
+
+function TFresnelLCLFont.TextSizeMaxWidth(const aText: string;
+  MaxWidth: TFresnelLength): TFresnelPoint;
+var
+  p: TPoint;
+begin
+  p:=Engine.TextSizeMaxWidth(Self,aText,Floor(Max(1,MaxWidth)));
+  Result.X:=p.X;
+  Result.Y:=p.Y;
+end;
+
+function TFresnelLCLFont.GetTool: TObject;
+begin
+  Result:=Self;
+end;
+
+initialization
+  TFresnelLCLWidgetSet.Create(nil);
+finalization
+  FresnelLCLWidgetSet.Free; // it will nil itself
+
+end.
+

src/lcl/fresnel.lclapp.pas

@@ -0,0 +1,71 @@
+unit Fresnel.LCLApp;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms,
+  Fresnel.Forms;
+
+type
+
+  { TFresnelLCLApplication }
+
+  TFresnelLCLApplication = class(TBaseFresnelApplication)
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure QueueAsyncCall(const AMethod: TDataEvent; Data: Pointer); override;
+    procedure RemoveAsyncCalls(const AnObject: TObject); override;
+    procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
+    procedure ReleaseComponent(AComponent: TComponent); override;
+  end;
+
+var
+  FresnelLCLApp: TFresnelLCLApplication;
+
+implementation
+
+{ TFresnelLCLApplication }
+
+constructor TFresnelLCLApplication.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FresnelLCLApp:=Self;
+end;
+
+destructor TFresnelLCLApplication.Destroy;
+begin
+  inherited Destroy;
+  FresnelLCLApp:=nil;
+end;
+
+procedure TFresnelLCLApplication.QueueAsyncCall(const AMethod: TDataEvent;
+  Data: Pointer);
+begin
+  Forms.Application.QueueAsyncCall(Forms.TDataEvent(AMethod),{%H-}PtrInt(Data));
+end;
+
+procedure TFresnelLCLApplication.RemoveAsyncCalls(const AnObject: TObject);
+begin
+  Forms.Application.RemoveAsyncCalls(AnObject);
+end;
+
+procedure TFresnelLCLApplication.RemoveAllHandlersOfObject(AnObject: TObject);
+begin
+  Forms.Application.RemoveAllHandlersOfObject(AnObject);
+end;
+
+procedure TFresnelLCLApplication.ReleaseComponent(AComponent: TComponent);
+begin
+  Forms.Application.ReleaseComponent(AComponent);
+end;
+
+initialization
+  TFresnelLCLApplication.Create(nil);
+finalization
+  FresnelLCLApp.Free; // will nil itself
+
+end.
+

src/lcl/fresnel.lclcontrols.pas

@@ -1,83 +1,20 @@
 unit Fresnel.LCLControls;
 
-{$mode ObjFPC}{$H+}
+{$mode objfpc}{$H+}
 
 interface
 
 uses
-  Classes, SysUtils, Types, Math, FPImage, Fresnel.DOM, Fresnel.Layouter,
-  Fresnel.Controls, fresnel.renderer, AvgLvlTree, LazLoggerBase,
-  Graphics, Controls, LCLIntf, Forms, LCLStrConsts, LResources, fresnel.events;
+  Classes, SysUtils, Controls, Forms, Fresnel.Layouter, Fresnel.DOM, Fresnel.LCL;
 
 type
-  TFresnelLCLFontEngine = class;
-
-  { TFresnelLCLFont }
-
-  TFresnelLCLFont = class(TInterfacedObject,IFresnelFont)
-  public
-    Engine: TFresnelLCLFontEngine;
-    Family: string;
-    Kerning: string;
-    Size: string;
-    Style: string;
-    Variant_: string;
-    Weight: string;
-    LCLFont: TFont;
-    destructor Destroy; override;
-    function GetFamily: string;
-    function GetKerning: string;
-    function GetSize: string;
-    function GetStyle: string;
-    function GetVariant: string;
-    function GetWeight: string;
-    function TextSize(const aText: string): TFresnelPoint; virtual;
-    function TextSizeMaxWidth(const aText: string; MaxWidth: TFresnelLength
-      ): TFresnelPoint; virtual;
-    function GetTool: TObject;
-  end;
-
-  { TFresnelLCLFontEngine }
-
-  TFresnelLCLFontEngine = class(TFresnelFontEngine)
-  private
-    FCanvas: TCanvas;
-    FFonts: TAvgLvlTree; // tree of TFresnelLCLFont sorted for
-  public
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-    function FindFont(const Desc: TFresnelFontDesc): TFresnelLCLFont; virtual;
-    function Allocate(const Desc: TFresnelFontDesc): IFresnelFont; override;
-    function TextSize(aFont: TFresnelLCLFont; const aText: string): TPoint; virtual;
-    function TextSizeMaxWidth(aFont: TFresnelLCLFont; const aText: string; MaxWidth: integer): TPoint; virtual;
-    function NeedLCLFont(aFont: TFresnelLCLFont): TFont; virtual;
-    property Canvas: TCanvas read FCanvas write FCanvas;
-  end;
-
-  { TFresnelLCLRenderer }
-
-  TFresnelLCLRenderer = class(TFresnelRenderer)
-  private
-    FCanvas: TCanvas;
-  protected
-    procedure FillRect(const aColor: TFPColor; const aRect: TFresnelRect);
-      override;
-    procedure Line(const aColor: TFPColor; const x1, y1, x2, y2: TFresnelLength); override;
-    procedure TextOut(const aLeft, aTop: TFresnelLength;
-      const aFont: IFresnelFont; const aColor: TFPColor;
-      const aText: string); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-    property Canvas: TCanvas read FCanvas write FCanvas;
-  end;
-
   { TFresnelLCLControl }
 
   TFresnelLCLControl = class(TCustomControl)
   private
     FClearing: boolean;
     FFontEngine: TFresnelLCLFontEngine;
-    FLayouter: TSimpleFresnelLayouter;
+    FLayouter: TViewportLayouter;
     FLayoutQueued: boolean;
     FRenderer: TFresnelLCLRenderer;
     FViewport: TFresnelViewport;
@@ -93,371 +30,43 @@ type
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     property Viewport: TFresnelViewport read FViewport;
-    property Layouter: TSimpleFresnelLayouter read FLayouter;
+    property Layouter: TViewportLayouter read FLayouter;
     property FontEngine: TFresnelLCLFontEngine read FFontEngine;
     property Renderer: TFresnelLCLRenderer read FRenderer;
     property LayoutQueued: boolean read FLayoutQueued write SetLayoutQueued;
   end;
 
-  { TOldFresnelCustomForm }
-
-  TOldFresnelCustomForm = class(TCustomForm,IFresnelStreamRoot)
-  private
-    FFontEngine: TFresnelLCLFontEngine;
-    FLayouter: TSimpleFresnelLayouter;
-    FRenderer: TFresnelLCLRenderer;
-    FViewport: TFresnelViewport;
-    FLayoutQueued: boolean;
-    FClearing: boolean;
-    function GetStylesheet: TStrings;
-    procedure OnDomChanged(Sender: TObject);
-    procedure OnQueuedLayout({%H-}Data: PtrInt);
-    procedure SetLayoutQueued(const AValue: boolean);
-    procedure SetStylesheet(const AValue: TStrings);
-  protected
-    procedure Notification(AComponent: TComponent; Operation: TOperation);
-      override;
-    procedure Paint; override;
-    function GetViewport: TFresnelViewport; virtual;
-  public
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
-    property Viewport: TFresnelViewport read FViewport;
-    property FontEngine: TFresnelLCLFontEngine read FFontEngine;
-    property Layouter: TSimpleFresnelLayouter read FLayouter;
-    property LayoutQueued: boolean read FLayoutQueued write SetLayoutQueued;
-    property Renderer: TFresnelLCLRenderer read FRenderer;
-    property Stylesheet: TStrings read GetStylesheet write SetStylesheet;
-  end;
-
-  { TOldFresnelForm }
-
-  TOldFresnelForm = class(TOldFresnelCustomForm)
-  published
-    property Stylesheet;
-  end;
-
-  IFresnelFormDesigner = interface
-    ['{095CB7DD-E291-45B6-892E-F486A38E597C}']
-    procedure InvalidateRect(Sender: TObject; ARect: TRect; Erase: boolean);
-    procedure SetDesignerFormBounds(Sender: TObject; NewBounds: TRect);
-    function GetDesignerClientWidth: integer;
-    function GetDesignerClientHeight: integer;
-  end;
-
-  { TCustomFresnelForm }
-
-  TCustomFresnelForm = class(TFresnelViewport)
-  private
-    FCanvas: TCanvas;
-    FClearing: boolean;
-    FDesigner: IFresnelFormDesigner;
-    FFontEngineLCL: TFresnelLCLFontEngine;
-    FForm: TCustomForm;
-    FLayouter: TSimpleFresnelLayouter;
-    FLayoutQueued: boolean;
-    FRenderer: TFresnelLCLRenderer;
-    FVisible: boolean;
-    procedure DoFormClick(Sender: TObject);
-    function GetAllowDropFiles: Boolean;
-    function GetAlphaBlend: Boolean;
-    function GetAlphaBlendValue: Byte;
-    function GetBorderIcons: TBorderIcons;
-    function GetCaption: TCaption;
-    function GetDefaultMonitor: TDefaultMonitor;
-    function GetEffectiveShowInTaskBar: TShowInTaskBar;
-    function GetFormBorderStyle: TFormBorderStyle;
-    function GetFormBoundsRect: TRect;
-    function GetFormHeight: integer;
-    function GetFormLeft: integer;
-    function GetFormState: TFormState;
-    function GetFormStyle: TFormStyle;
-    function GetFormTop: integer;
-    function GetFormWidth: integer;
-    function GetIcon: TIcon;
-    function GetPosition: TPosition;
-    function GetShowInTaskbar: TShowInTaskbar;
-    function GetVisible: boolean;
-    function GetWindowState: TWindowState;
-    function IsIconStored: Boolean;
-    procedure OnFormResize(Sender: TObject);
-    procedure SetAllowDropFiles(const AValue: Boolean);
-    procedure SetAlphaBlend(const AValue: Boolean);
-    procedure SetAlphaBlendValue(const AValue: Byte);
-    procedure SetBorderIcons(const AValue: TBorderIcons);
-    procedure SetCanvas(const AValue: TCanvas);
-    procedure SetCaption(const AValue: TCaption);
-    procedure SetDefaultMonitor(const AValue: TDefaultMonitor);
-    procedure SetFormBorderStyle(const AValue: TFormBorderStyle);
-    procedure SetFormBoundsRect(const AValue: TRect);
-    procedure SetFormHeight(const AValue: integer);
-    procedure SetFormLeft(const AValue: integer);
-    procedure SetFormStyle(const AValue: TFormStyle);
-    procedure SetFormTop(const AValue: integer);
-    procedure SetFormWidth(const AValue: integer);
-    procedure SetIcon(const AValue: TIcon);
-    procedure SetLayoutQueued(const AValue: boolean);
-    procedure SetPosition(const AValue: TPosition);
-    procedure SetShowInTaskBar(const AValue: TShowInTaskbar);
-    procedure SetVisible(const AValue: boolean);
-    procedure SetWindowState(const AValue: TWindowState);
-    function VisibleIsStored: Boolean;
-  protected
-    function GetHeight: TFresnelLength; override;
-    function GetWidth: TFresnelLength; override;
-    procedure FormPaint(Sender: TObject); virtual;
-    procedure Notification(AComponent: TComponent; Operation: TOperation);
-      override;
-    procedure OnQueuedLayout({%H-}Data: PtrInt); virtual;
-    procedure ProcessResource; virtual;
-    procedure SetName(const NewName: TComponentName); override;
-    procedure SetHeight({%H-}AValue: TFresnelLength); override;
-    procedure SetWidth({%H-}AValue: TFresnelLength); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-    constructor CreateNew(AOwner: TComponent); virtual;
-    destructor Destroy; override;
-    procedure DomChanged; override;
-    procedure Hide;
-    procedure Show; virtual;
-    function ShowModal: TModalResult; virtual;
-    property AllowDropFiles: Boolean read GetAllowDropFiles write SetAllowDropFiles default false;
-    property AlphaBlend: Boolean read GetAlphaBlend write SetAlphaBlend default false;
-    property AlphaBlendValue: Byte read GetAlphaBlendValue write SetAlphaBlendValue default 255;
-    property BorderIcons: TBorderIcons read GetBorderIcons write SetBorderIcons
-      default [biSystemMenu, biMinimize, biMaximize];
-    property BorderStyle: TFormBorderStyle
-                      read GetFormBorderStyle write SetFormBorderStyle default bsSizeable;
-    property Canvas: TCanvas read FCanvas write SetCanvas;
-    property Caption: TCaption read GetCaption write SetCaption;
-    property DefaultMonitor: TDefaultMonitor read GetDefaultMonitor
-      write SetDefaultMonitor default dmActiveForm;
-    property Designer: IFresnelFormDesigner read FDesigner write FDesigner;
-    property EffectiveShowInTaskBar: TShowInTaskBar read GetEffectiveShowInTaskBar;
-    property FontEngineLCL: TFresnelLCLFontEngine read FFontEngineLCL;
-    property Form: TCustomForm read FForm;
-    property FormState: TFormState read GetFormState;
-    property FormStyle: TFormStyle read GetFormStyle write SetFormStyle default fsNormal;
-    property Icon: TIcon read GetIcon write SetIcon stored IsIconStored;
-    property Layouter: TSimpleFresnelLayouter read FLayouter;
-    property LayoutQueued: boolean read FLayoutQueued write SetLayoutQueued;
-    property Position: TPosition read GetPosition write SetPosition default poDesigned;
-    property Renderer: TFresnelLCLRenderer read FRenderer;
-    property ShowInTaskBar: TShowInTaskbar read GetShowInTaskbar write SetShowInTaskBar
-                                    default stDefault;
-    property Visible: boolean read GetVisible write SetVisible stored VisibleIsStored default false;
-    property WindowState: TWindowState read GetWindowState write SetWindowState
-                                       default wsNormal;
-    property FormBoundsRect: TRect read GetFormBoundsRect write SetFormBoundsRect;
-    property FormLeft: integer read GetFormLeft write SetFormLeft;
-    property FormTop: integer read GetFormTop write SetFormTop;
-    property FormWidth: integer read GetFormWidth write SetFormWidth;
-    property FormHeight: integer read GetFormHeight write SetFormHeight;
-  end;
-
-  { TFresnelForm }
-
-  TFresnelForm = class(TCustomFresnelForm)
-  published
-    property AllowDropFiles;
-    property AlphaBlend;
-    property AlphaBlendValue;
-    property BorderIcons;
-    property BorderStyle;
-    property Caption;
-    property DefaultMonitor;
-    property FormHeight;
-    property FormLeft;
-    property FormStyle;
-    property FormTop;
-    property FormWidth;
-    property Icon;
-    property Position;
-    property ShowInTaskBar;
-    property Stylesheet;
-    property Visible;
-    property WindowState;
-  end;
-
-
-function CompareFresnelLCLFont(Item1, Item2: Pointer): integer;
-function CompareFresnelFontDescWithLCLFont(Key, Item: Pointer): integer;
-procedure FresnelRectToRect(const Src: TFresnelRect; out Dest: TRect);
-
 implementation
 
-uses fresnel.lclevents;
-
-function CompareFresnelLCLFont(Item1, Item2: Pointer): integer;
-var
-  Font1: TFresnelLCLFont absolute Item1;
-  Font2: TFresnelLCLFont absolute Item2;
-begin
-  Result:=CompareText(Font1.Family,Font2.Family);
-  if Result<>0 then exit;
-  if Font1.Size<Font2.Size then
-    exit(-1)
-  else if Font1.Size>Font2.Size then
-    exit(1);
-  Result:=CompareText(Font1.Style,Font2.Style);
-  if Result<>0 then exit;
-  Result:=CompareText(Font1.Weight,Font2.Weight);
-  if Result<>0 then exit;
-  Result:=CompareText(Font1.Variant_,Font2.Variant_);
-  if Result<>0 then exit;
-  Result:=CompareText(Font1.Kerning,Font2.Kerning);
-end;
-
-function CompareFresnelFontDescWithLCLFont(Key, Item: Pointer): integer;
-var
-  Desc: PFresnelFontDesc absolute Key;
-  aFont: TFresnelLCLFont absolute Item;
-begin
-  Result:=CompareText(Desc^.Family,aFont.Family);
-  if Result<>0 then exit;
-  if Desc^.Size<aFont.Size then
-    exit(-1)
-  else if Desc^.Size>aFont.Size then
-    exit(1);
-  Result:=CompareText(Desc^.Style,aFont.Style);
-  if Result<>0 then exit;
-  Result:=CompareText(Desc^.Weight,aFont.Weight);
-  if Result<>0 then exit;
-  Result:=CompareText(Desc^.Variant_,aFont.Variant_);
-  if Result<>0 then exit;
-  Result:=CompareText(Desc^.Kerning,aFont.Kerning);
-end;
-
-procedure FresnelRectToRect(const Src: TFresnelRect; out Dest: TRect);
-begin
-  Dest.Left:=floor(Src.Left);
-  Dest.Top:=floor(Src.Top);
-  Dest.Right:=ceil(Src.Right);
-  Dest.Bottom:=ceil(Src.Bottom);
-end;
-
-{ TCustomFresnelForm }
-
-procedure TCustomFresnelForm.DomChanged;
-begin
-  LayoutQueued:=true;
-end;
-
-procedure TCustomFresnelForm.Hide;
-begin
-  Form.Hide;
-end;
-
-procedure TCustomFresnelForm.Show;
-begin
-  Form.Show;
-end;
-
-function TCustomFresnelForm.ShowModal: TModalResult;
-begin
-  Result:=Form.ShowModal;
-end;
-
-procedure TCustomFresnelForm.OnQueuedLayout(Data: PtrInt);
-begin
-  try
-    ApplyCSS;
-    //Layouter.WriteLayoutTree;
-    Layouter.Apply(Self);
-    if Designer<>nil then
-      Designer.InvalidateRect(Self,Bounds(0,0,ceil(Width),ceil(Height)),false)
-    else
-      Form.Invalidate;
-  finally
-    FLayoutQueued:=false;
-  end;
-end;
-
-procedure TCustomFresnelForm.ProcessResource;
-begin
-  if not InitResourceComponent(Self, TFresnelForm) then
-    raise EResNotFound.CreateFmt(rsFormResourceSNotFoundForResourcelessFormsCreateNew, [ClassName]);
-end;
-
-procedure TCustomFresnelForm.FormPaint(Sender: TObject);
-begin
-  if Designer<>nil then exit;
-  Renderer.Draw(Self);
-end;
+{ TFresnelLCLControl }
 
-procedure TCustomFresnelForm.SetLayoutQueued(const AValue: boolean);
+procedure TFresnelLCLControl.SetLayoutQueued(const AValue: boolean);
 begin
   if FLayoutQueued=AValue then Exit;
   if FClearing then exit;
-  if csDestroyingHandle in Form.ControlState then exit;
+  if csDestroyingHandle in ControlState then exit;
   if csDestroying in ComponentState then exit;
   FLayoutQueued:=AValue;
   if FLayoutQueued then
-    Application.QueueAsyncCall(@OnQueuedLayout,0);
-end;
-
-procedure TCustomFresnelForm.SetPosition(const AValue: TPosition);
-begin
-  Form.Position:=AValue;
-end;
-
-procedure TCustomFresnelForm.SetShowInTaskBar(const AValue: TShowInTaskbar);
-begin
-  Form.ShowInTaskBar:=AValue;
-end;
-
-procedure TCustomFresnelForm.SetVisible(const AValue: boolean);
-begin
-  if csDesigning in ComponentState then
-    FVisible:=AValue
-  else
-    Form.Visible:=AValue;
-end;
-
-procedure TCustomFresnelForm.SetWindowState(const AValue: TWindowState);
-begin
-  Form.WindowState:=AValue;
+    Forms.Application.QueueAsyncCall(@OnQueuedLayout,0);
 end;
 
-function TCustomFresnelForm.VisibleIsStored: Boolean;
-begin
-  Result:=Visible;
-end;
-
-function TCustomFresnelForm.GetHeight: TFresnelLength;
-begin
-  if Designer<>nil then
-    Result:=Designer.GetDesignerClientHeight
-  else
-    Result:=Form.ClientHeight;
-end;
-
-function TCustomFresnelForm.GetWidth: TFresnelLength;
-begin
-  if Designer<>nil then
-    Result:=Designer.GetDesignerClientWidth
-  else
-    Result:=Form.ClientWidth;
-end;
-
-function TCustomFresnelForm.GetAllowDropFiles: Boolean;
+procedure TFresnelLCLControl.OnDomChanged(Sender: TObject);
 begin
-  Result:=Form.AllowDropFiles;
+  LayoutQueued:=true;
 end;
 
-procedure TCustomFresnelForm.DoFormClick(Sender: TObject);
-
+procedure TFresnelLCLControl.HandleClick(Sender: TObject);
 Var
   aInit : TFresnelMouseEventInit;
   aEl : TFresnelElement;
   evt : TFresnelMouseEvent;
 
 begin
-  InitMouseEvent(FForm,aInit);
-  aEl:=GetElementAt(aInit.PagePos.X,aInit.PagePos.Y);
+  InitMouseEvent(Self,aInit);
+  aEl:=FViewport.GetElementAt(aInit.PagePos.X,aInit.PagePos.Y);
   if aEl=Nil then
-    aEl:=Self;
+    aEl:=Self.Viewport;
   evt:=aEl.EventDispatcher.CreateEvent(aEl,evtClick) as TFresnelMouseEvent;
   try
     evt.initEvent(aInit);
@@ -467,324 +76,64 @@ begin
   end;
 end;
 
-procedure TCustomFresnelForm.OnFormResize(Sender: TObject);
-begin
-  inherited SetWidth(Form.ClientWidth);
-  inherited SetHeight(Form.ClientHeight);
-end;
-
-function TCustomFresnelForm.GetAlphaBlend: Boolean;
-begin
-  Result:=Form.AlphaBlend;
-end;
-
-function TCustomFresnelForm.GetAlphaBlendValue: Byte;
-begin
-  Result:=Form.AlphaBlendValue;
-end;
-
-function TCustomFresnelForm.GetBorderIcons: TBorderIcons;
-begin
-  Result:=Form.BorderIcons;
-end;
-
-function TCustomFresnelForm.GetCaption: TCaption;
-begin
-  Result:=Form.Caption;
-end;
-
-function TCustomFresnelForm.GetDefaultMonitor: TDefaultMonitor;
-begin
-  Result:=Form.DefaultMonitor;
-end;
-
-function TCustomFresnelForm.GetEffectiveShowInTaskBar: TShowInTaskBar;
-begin
-  Result:=Form.EffectiveShowInTaskBar;
-end;
-
-function TCustomFresnelForm.GetFormBorderStyle: TFormBorderStyle;
-begin
-  Result:=Form.BorderStyle;
-end;
-
-function TCustomFresnelForm.GetFormBoundsRect: TRect;
-begin
-  Result:=Form.BoundsRect;
-end;
-
-function TCustomFresnelForm.GetFormHeight: integer;
-begin
-  Result:=Form.Height;
-end;
-
-function TCustomFresnelForm.GetFormLeft: integer;
-begin
-  Result:=Form.Left;
-end;
-
-function TCustomFresnelForm.GetFormState: TFormState;
-begin
-  Result:=Form.FormState;
-end;
-
-function TCustomFresnelForm.GetFormStyle: TFormStyle;
-begin
-  Result:=Form.FormStyle;
-end;
-
-function TCustomFresnelForm.GetFormTop: integer;
-begin
-  Result:=Form.Top;
-end;
-
-function TCustomFresnelForm.GetFormWidth: integer;
-begin
-  Result:=Form.Width;
-end;
-
-function TCustomFresnelForm.GetIcon: TIcon;
-begin
-  Result:=Form.Icon;
-end;
-
-function TCustomFresnelForm.GetPosition: TPosition;
-begin
-  Result:=Form.Position;
-end;
-
-function TCustomFresnelForm.GetShowInTaskbar: TShowInTaskbar;
-begin
-  Result:=Form.ShowInTaskBar;
-end;
-
-function TCustomFresnelForm.GetVisible: boolean;
-begin
-  if csDesigning in ComponentState then
-    Result:=FVisible
-  else
-    Result:=Form.Visible;
-end;
-
-function TCustomFresnelForm.GetWindowState: TWindowState;
-begin
-  Result:=Form.WindowState;
-end;
-
-function TCustomFresnelForm.IsIconStored: Boolean;
-begin
-  Result:=Icon<>nil;
-end;
-
-procedure TCustomFresnelForm.SetAllowDropFiles(const AValue: Boolean);
-begin
-  Form.AllowDropFiles:=AValue;
-end;
-
-procedure TCustomFresnelForm.SetAlphaBlend(const AValue: Boolean);
-begin
-  Form.AlphaBlend:=AValue;
-end;
-
-procedure TCustomFresnelForm.SetAlphaBlendValue(const AValue: Byte);
-begin
-  Form.AlphaBlendValue:=AValue;
-end;
-
-procedure TCustomFresnelForm.SetBorderIcons(const AValue: TBorderIcons);
-begin
-  Form.BorderIcons:=AValue;
-end;
-
-procedure TCustomFresnelForm.SetCanvas(const AValue: TCanvas);
-begin
-  if FCanvas=AValue then Exit;
-  FCanvas:=AValue;
-  FontEngineLCL.Canvas:=FCanvas;
-  Renderer.Canvas:=FCanvas;
-end;
-
-procedure TCustomFresnelForm.SetCaption(const AValue: TCaption);
-begin
-  Form.Caption:=AValue;
-end;
-
-procedure TCustomFresnelForm.SetDefaultMonitor(const AValue: TDefaultMonitor);
-begin
-  Form.DefaultMonitor:=AValue;
-end;
-
-procedure TCustomFresnelForm.SetFormBorderStyle(const AValue: TFormBorderStyle);
-begin
-  Form.BorderStyle:=AValue;
-end;
-
-procedure TCustomFresnelForm.SetFormBoundsRect(const AValue: TRect);
-begin
-  Form.BoundsRect:=AValue;
-end;
-
-procedure TCustomFresnelForm.SetFormHeight(const AValue: integer);
-begin
-  Form.Height:=AValue;
-  if Designer<>nil then
-    Designer.SetDesignerFormBounds(Self,Form.BoundsRect);
-end;
-
-procedure TCustomFresnelForm.SetFormLeft(const AValue: integer);
-begin
-  Form.Left:=AValue;
-  if Designer<>nil then
-    Designer.SetDesignerFormBounds(Self,Form.BoundsRect);
-end;
-
-procedure TCustomFresnelForm.SetFormStyle(const AValue: TFormStyle);
-begin
-  Form.FormStyle:=AValue;
-end;
-
-procedure TCustomFresnelForm.SetFormTop(const AValue: integer);
-begin
-  Form.Top:=AValue;
-  if Designer<>nil then
-    Designer.SetDesignerFormBounds(Self,Form.BoundsRect);
-end;
-
-procedure TCustomFresnelForm.SetFormWidth(const AValue: integer);
-begin
-  Form.Width:=AValue;
-  if Designer<>nil then
-    Designer.SetDesignerFormBounds(Self,Form.BoundsRect);
-end;
-
-procedure TCustomFresnelForm.SetIcon(const AValue: TIcon);
+procedure TFresnelLCLControl.OnQueuedLayout(Data: PtrInt);
 begin
-  Form.Icon:=AValue;
+  ViewPort.ApplyCSS;
+  //Layouter.WriteLayoutTree;
+  Layouter.Apply(ViewPort);
+  Invalidate;
 end;
 
-procedure TCustomFresnelForm.Notification(AComponent: TComponent;
+procedure TFresnelLCLControl.Notification(AComponent: TComponent;
   Operation: TOperation);
 begin
   inherited Notification(AComponent, Operation);
   if Operation=opRemove then
   begin
-    if AComponent=FForm then
+    if AComponent=FViewport then
+      FViewport:=nil;
+    if AComponent=FLayouter then
     begin
-      FForm:=nil;
-      FCanvas:=nil;
+      FLayouter:=nil;
+      if FViewport<>nil then
+        FViewport.Layouter:=nil;
     end;
-    if AComponent=FFontEngineLCL then
-      FFontEngineLCL:=nil;
-    if AComponent=FRenderer then
-      FRenderer:=nil;
   end;
 end;
 
-procedure TCustomFresnelForm.SetName(const NewName: TComponentName);
-begin
-  inherited SetName(NewName);
-  Form.Name:=NewName;
-end;
-
-procedure TCustomFresnelForm.SetHeight(AValue: TFresnelLength);
-begin
-  raise Exception.Create('TCustomFresnelForm.SetHeight is a derived value, set FormHeight instead');
-end;
-
-procedure TCustomFresnelForm.SetWidth(AValue: TFresnelLength);
+procedure TFresnelLCLControl.Paint;
 begin
-  raise Exception.Create('TCustomFresnelForm.SetWidth is a derived value, set FormWidth instead');
-end;
+  inherited Paint;
 
-constructor TCustomFresnelForm.Create(AOwner: TComponent);
-begin
-  GlobalNameSpace.BeginWrite;
-  try
-    CreateNew(AOwner);
-    if (ClassType <> TFresnelForm) and not (csDesigning in ComponentState) then
-    begin
-      ProcessResource;
-    end;
-  finally
-    GlobalNameSpace.EndWrite;
-  end;
+  Renderer.Draw(Viewport);
 end;
 
-constructor TCustomFresnelForm.CreateNew(AOwner: TComponent);
+constructor TFresnelLCLControl.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
-  FForm:=TCustomForm.CreateNew(nil);
-  FForm.Name:=Name;
-  FForm.Visible:=false;
-  FForm.OnResize:=@OnFormResize;
-  FForm.OnClick:=@DoFormClick;
-  FCanvas:=Form.Canvas;
-  Form.OnPaint:=@FormPaint;
-
-  FFontEngineLCL:=TFresnelLCLFontEngine.Create(nil);
-  FontEngine:=FontEngineLCL;
-  FontEngineLCL.Canvas:=Canvas;
-
+  FViewport:=TFresnelViewport.Create(nil);
+  FViewport.OnDomChanged:=@OnDomChanged;
+  FFontEngine:=TFresnelLCLFontEngine.Create(nil);
+  FViewport.FontEngine:=FontEngine;
+  FontEngine.Canvas:=Canvas;
+  FViewport.Name:='Viewport';
   FLayouter:=TSimpleFresnelLayouter.Create(nil);
-  Layouter.Viewport:=Self;
-
+  Layouter.Viewport:=ViewPort;
   FRenderer:=TFresnelLCLRenderer.Create(nil);
   FRenderer.Canvas:=Canvas;
+  OnClick:=@HandleClick;
 end;
 
-destructor TCustomFresnelForm.Destroy;
+destructor TFresnelLCLControl.Destroy;
 begin
   FClearing:=true;
   FreeAndNil(FRenderer);
   FreeAndNil(FLayouter);
-  FontEngine:=nil;
-  FreeAndNil(FFontEngineLCL);
-  FCanvas:=nil;
-  FreeAndNil(FForm);
-  Application.RemoveAllHandlersOfObject(Self);
+  FreeAndNil(FViewport);
+  FreeAndNil(FFontEngine);
   inherited Destroy;
 end;
 
-{ TFresnelLCLRenderer }
-
-procedure TFresnelLCLRenderer.FillRect(const aColor: TFPColor;
-  const aRect: TFresnelRect);
-begin
-  Canvas.Brush.FPColor:=aColor;
-  Canvas.Brush.Style:=bsSolid;
-  Canvas.FillRect(Rect(floor(FOrigin.X+aRect.Left),floor(FOrigin.Y+aRect.Top),
-                       ceil(FOrigin.X+aRect.Right),ceil(FOrigin.Y+aRect.Bottom)));
-end;
-
-procedure TFresnelLCLRenderer.Line(const aColor: TFPColor; const x1, y1, x2,
-  y2: TFresnelLength);
-begin
-  Canvas.Pen.FPColor:=aColor;
-  Canvas.Pen.Style:=psSolid;
-  Canvas.Line(round(FOrigin.X+x1),round(FOrigin.Y+y1),round(FOrigin.X+x2),round(FOrigin.Y+y2));
-end;
-
-procedure TFresnelLCLRenderer.TextOut(const aLeft, aTop: TFresnelLength;
-  const aFont: IFresnelFont; const aColor: TFPColor; const aText: string
-  );
-var
-  ts: TTextStyle;
-  aFresnelFont: TFresnelLCLFont;
-begin
-  aFresnelFont:=aFont.GetTool as TFresnelLCLFont;
-  Canvas.Font:=aFresnelFont.LCLFont;
-  Canvas.Font.FPColor:=aColor;
-  ts:=Canvas.TextStyle;
-  ts.Opaque:=false;
-  Canvas.TextStyle:=ts;
-  Canvas.TextOut(round(FOrigin.X+aLeft),round(FOrigin.Y+aTop),aText);
-end;
-
-constructor TFresnelLCLRenderer.Create(AOwner: TComponent);
-begin
-  inherited Create(AOwner);
-end;
-
 { TOldFresnelCustomForm }
 
 function TOldFresnelCustomForm.GetStylesheet: TStrings;
@@ -904,293 +253,5 @@ begin
   end;
 end;
 
-{ TFresnelLCLControl }
-
-procedure TFresnelLCLControl.SetLayoutQueued(const AValue: boolean);
-begin
-  if FLayoutQueued=AValue then Exit;
-  if FClearing then exit;
-  if csDestroyingHandle in ControlState then exit;
-  if csDestroying in ComponentState then exit;
-  FLayoutQueued:=AValue;
-  if FLayoutQueued then
-    Application.QueueAsyncCall(@OnQueuedLayout,0);
-end;
-
-procedure TFresnelLCLControl.OnDomChanged(Sender: TObject);
-begin
-  LayoutQueued:=true;
-end;
-
-procedure TFresnelLCLControl.HandleClick(Sender: TObject);
-Var
-  aInit : TFresnelMouseEventInit;
-  aEl : TFresnelElement;
-  evt : TFresnelMouseEvent;
-
-begin
-  InitMouseEvent(Self,aInit);
-  aEl:=FViewport.GetElementAt(aInit.PagePos.X,aInit.PagePos.Y);
-  if aEl=Nil then
-    aEl:=Self.Viewport;
-  evt:=aEl.EventDispatcher.CreateEvent(aEl,evtClick) as TFresnelMouseEvent;
-  try
-    evt.initEvent(aInit);
-    aEl.EventDispatcher.DispatchEvent(evt);
-  finally
-    evt.Free;
-  end;
-end;
-
-procedure TFresnelLCLControl.OnQueuedLayout(Data: PtrInt);
-begin
-  ViewPort.ApplyCSS;
-  //Layouter.WriteLayoutTree;
-  Layouter.Apply(ViewPort);
-  Invalidate;
-end;
-
-procedure TFresnelLCLControl.Notification(AComponent: TComponent;
-  Operation: TOperation);
-begin
-  inherited Notification(AComponent, Operation);
-  if Operation=opRemove then
-  begin
-    if AComponent=FViewport then
-      FViewport:=nil;
-    if AComponent=FLayouter then
-    begin
-      FLayouter:=nil;
-      if FViewport<>nil then
-        FViewport.Layouter:=nil;
-    end;
-  end;
-end;
-
-procedure TFresnelLCLControl.Paint;
-begin
-  inherited Paint;
-
-  Renderer.Draw(Viewport);
-end;
-
-constructor TFresnelLCLControl.Create(AOwner: TComponent);
-begin
-  inherited Create(AOwner);
-  FViewport:=TFresnelViewport.Create(nil);
-  FViewport.OnDomChanged:=@OnDomChanged;
-  FFontEngine:=TFresnelLCLFontEngine.Create(nil);
-  FViewport.FontEngine:=FontEngine;
-  FontEngine.Canvas:=Canvas;
-  FViewport.Name:='Viewport';
-  FLayouter:=TSimpleFresnelLayouter.Create(nil);
-  Layouter.Viewport:=ViewPort;
-  FRenderer:=TFresnelLCLRenderer.Create(nil);
-  FRenderer.Canvas:=Canvas;
-  OnClick:=@HandleClick;
-end;
-
-destructor TFresnelLCLControl.Destroy;
-begin
-  FClearing:=true;
-  FreeAndNil(FRenderer);
-  FreeAndNil(FLayouter);
-  FreeAndNil(FViewport);
-  FreeAndNil(FFontEngine);
-  inherited Destroy;
-end;
-
-{ TFresnelLCLFontEngine }
-
-constructor TFresnelLCLFontEngine.Create(AOwner: TComponent);
-begin
-  inherited Create(AOwner);
-  FFonts:=TAvgLvlTree.Create(@CompareFresnelLCLFont);
-end;
-
-destructor TFresnelLCLFontEngine.Destroy;
-var
-  Node: TAvgLvlTreeNode;
-  aFont: TFresnelLCLFont;
-begin
-  Node:=FFonts.Root;
-  while Node<>nil do
-  begin
-    aFont:=TFresnelLCLFont(Node.Data);
-    Node.Data:=nil;
-    aFont._Release;
-    Node:=Node.Successor;
-  end;
-  FreeAndNil(FFonts);
-  inherited Destroy;
-end;
-
-function TFresnelLCLFontEngine.FindFont(const Desc: TFresnelFontDesc
-  ): TFresnelLCLFont;
-var
-  Node: TAvgLvlTreeNode;
-begin
-  Node:=FFonts.FindKey(@Desc,@CompareFresnelFontDescWithLCLFont);
-  if Node=nil then
-    Result:=nil
-  else
-    Result:=TFresnelLCLFont(Node.Data);
-end;
-
-function TFresnelLCLFontEngine.Allocate(const Desc: TFresnelFontDesc
-  ): IFresnelFont;
-var
-  aFont: TFresnelLCLFont;
-begin
-  aFont:=FindFont(Desc);
-  if aFont<>nil then
-    exit(aFont);
-  aFont:=TFresnelLCLFont.Create;
-  aFont.Engine:=Self;
-  aFont._AddRef;
-  aFont.Family:=Desc.Family;
-  aFont.Kerning:=Desc.Kerning;
-  aFont.Size:=Desc.Size;
-  aFont.Style:=Desc.Style;
-  aFont.Variant_:=Desc.Variant_;
-  aFont.Weight:=Desc.Weight;
-  FFonts.Add(aFont);
-  Result:=aFont;
-end;
-
-function TFresnelLCLFontEngine.TextSize(aFont: TFresnelLCLFont;
-  const aText: string): TPoint;
-var
-  aSize: TSize;
-begin
-  Canvas.Font:=NeedLCLFont(aFont);
-  aSize:=Canvas.TextExtent(aText);
-  Result.X:=aSize.cx;
-  Result.Y:=aSize.cy;
-end;
-
-function TFresnelLCLFontEngine.TextSizeMaxWidth(aFont: TFresnelLCLFont;
-  const aText: string; MaxWidth: integer): TPoint;
-var
-  aSize: TSize;
-begin
-  Canvas.Font:=NeedLCLFont(aFont);
-
-  if LCLIntf.GetTextExtentExPoint(Canvas.Handle, PChar(aText), Length(aText),
-    MaxWidth, nil, nil, aSize) then
-  begin
-    Result.X:=aSize.cx;
-    Result.Y:=aSize.cy;
-  end else begin
-    Result.X:=0;
-    Result.Y:=0;
-  end;
-end;
-
-function TFresnelLCLFontEngine.NeedLCLFont(aFont: TFresnelLCLFont): TFont;
-var
-  aLCLFont: TFont;
-  v: integer;
-  aStyle: TFontStyles;
-begin
-  if aFont.LCLFont=nil then
-  begin
-    aLCLFont:=TFont.Create;
-    aFont.LCLFont:=aLCLFont;
-    case aFont.Size of
-    'xx-small': aLCLFont.Size:=6;
-    'x-small': aLCLFont.Size:=7;
-    'smaller': aLCLFont.Size:=8;
-    'small': aLCLFont.Size:=8;
-    'medium': aLCLFont.Size:=10;
-    'large': aLCLFont.Size:=13;
-    'larger': aLCLFont.Size:=15;
-    'x-large': aLCLFont.Size:=20;
-    'xx-large': aLCLFont.Size:=30;
-    else
-      if TryStrToInt(aFont.Size,v) then
-      begin
-        if v<4 then v:=4;
-        aLCLFont.Size:=v;
-      end;
-    end;
-    aStyle:=[];
-    case aFont.Weight of
-    'bold',
-    'bolder',
-    '500',
-    '600',
-    '700': Include(aStyle,fsBold);
-    end;
-    case aFont.Style of
-    'italic': Include(aStyle,fsItalic);
-    end;
-    aLCLFont.Style:=aStyle;
-  end;
-  Result:=aFont.LCLFont;
-end;
-
-{ TFresnelLCLFont }
-
-destructor TFresnelLCLFont.Destroy;
-begin
-  FreeAndNil(LCLFont);
-  inherited Destroy;
-end;
-
-function TFresnelLCLFont.GetFamily: string;
-begin
-  Result:=Family;
-end;
-
-function TFresnelLCLFont.GetKerning: string;
-begin
-  Result:=Kerning;
-end;
-
-function TFresnelLCLFont.GetSize: string;
-begin
-  Result:=Size;
-end;
-
-function TFresnelLCLFont.GetStyle: string;
-begin
-  Result:=Style;
-end;
-
-function TFresnelLCLFont.GetVariant: string;
-begin
-  Result:=Variant_;
-end;
-
-function TFresnelLCLFont.GetWeight: string;
-begin
-  Result:=Weight;
-end;
-
-function TFresnelLCLFont.TextSize(const aText: string): TFresnelPoint;
-var
-  p: TPoint;
-begin
-  p:=Engine.TextSize(Self,aText);
-  Result.X:=p.X;
-  Result.Y:=p.Y;
-end;
-
-function TFresnelLCLFont.TextSizeMaxWidth(const aText: string;
-  MaxWidth: TFresnelLength): TFresnelPoint;
-var
-  p: TPoint;
-begin
-  p:=Engine.TextSizeMaxWidth(Self,aText,Floor(Max(1,MaxWidth)));
-  Result.X:=p.X;
-  Result.Y:=p.Y;
-end;
-
-function TFresnelLCLFont.GetTool: TObject;
-begin
-  Result:=Self;
-end;
-
 end.
 

src/lcl/fresnel.lclevents.pp

@@ -1,23 +0,0 @@
-unit Fresnel.LCLEvents;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, Fresnel.Events, Controls;
-
-Function InitMouseEvent(aCtrl : TControl; Out aInit : TFresnelMouseEventInit) : Boolean;
-
-implementation
-
-Function InitMouseEvent(aCtrl : TControl; Out aInit : TFresnelMouseEventInit) : Boolean;
-
-begin
-  aInit.ScreenPos:=Mouse.CursorPos;
-  aInit.PagePos:=aCtrl.ScreenToClient(aInit.ScreenPos);
-  Result:=True;
-end;
-
-end.
-

src/lcl/fresnel.pas

@@ -0,0 +1,16 @@
+{
+  Binding the Fresnel units of the Fresnel-LCL-WidgetSet
+}
+unit Fresnel;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Fresnel.LCL, Fresnel.LCLApp;
+
+implementation
+
+end.
+

src/lcl/fresnellcl.lpk

@@ -0,0 +1,58 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <Package Version="5">
+    <Name Value="FresnelLCL"/>
+    <Author Value="Mattias Gaertner"/>
+    <CompilerOptions>
+      <Version Value="11"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <Other>
+        <ConfigFile>
+          <WriteConfigFilePath Value=""/>
+        </ConfigFile>
+      </Other>
+    </CompilerOptions>
+    <Description Value="Runtime package for using Fresnel inside an LCL application."/>
+    <License Value="Same as LCL.
+Modified LGPL-2."/>
+    <Version Minor="3"/>
+    <Files Count="4">
+      <Item1>
+        <Filename Value="fresnel.lcl.pas"/>
+        <UnitName Value="Fresnel.LCL"/>
+      </Item1>
+      <Item2>
+        <Filename Value="fresnel.lclcontrols.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="Fresnel.LCLControls"/>
+      </Item2>
+      <Item3>
+        <Filename Value="fresnel.pas"/>
+        <UnitName Value="Fresnel"/>
+      </Item3>
+      <Item4>
+        <Filename Value="fresnel.lclapp.pas"/>
+        <UnitName Value="Fresnel.LCLApp"/>
+      </Item4>
+    </Files>
+    <CompatibilityMode Value="True"/>
+    <RequiredPkgs Count="2">
+      <Item1>
+        <PackageName Value="FresnelBase"/>
+        <MaxVersion Minor="2"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>

src/lcl/fresnellcl.pas

@@ -0,0 +1,15 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit FresnelLCL;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+  Fresnel.LCL, Fresnel, Fresnel.LCLApp;
+
+implementation
+
+end.

src/skia/fresnel.skiarenderer.pas

@@ -0,0 +1,424 @@
+unit Fresnel.SkiaRenderer;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Types, AVL_Tree, FpImage, System.UITypes, AvgLvlTree,
+  LazLoggerBase, System.Skia, Fresnel.Classes, Fresnel.DOM, Fresnel.Renderer;
+
+type
+  TFresnelSkiaFontEngine = class;
+
+  { TFresnelSkiaTypeFace }
+
+  TFresnelSkiaTypeFace = class
+  private
+    FRefCount: integer;
+  public
+    Engine: TFresnelSkiaFontEngine;
+    SKTypeFace: ISkTypeface;
+    CSSFamily: string;
+    CSSKerning: string;
+    CSSStyle: string;
+    CSSVariant_: string;
+    CSSWeight: string;
+    procedure AddRef;
+    procedure Release;
+    property RefCount: integer read FRefCount;
+  end;
+
+  { TFresnelSkiaFont }
+
+  TFresnelSkiaFont = class(TInterfacedObject,IFresnelFont)
+  private
+    FTypeFace: TFresnelSkiaTypeFace;
+    procedure SetTypeFace(const AValue: TFresnelSkiaTypeFace);
+  public
+    Engine: TFresnelSkiaFontEngine;
+    SKFont: ISkFont;
+    CSSSize: string;
+    destructor Destroy; override;
+    function GetFamily: string;
+    function GetKerning: string;
+    function GetSize: string;
+    function GetStyle: string;
+    function GetVariant: string;
+    function GetWeight: string;
+    function TextSize(const aText: string): TFresnelPoint; virtual;
+    function TextSizeMaxWidth(const aText: string; MaxWidth: TFresnelLength
+      ): TFresnelPoint; virtual;
+    function GetTool: TObject;
+    property TypeFace: TFresnelSkiaTypeFace read FTypeFace write SetTypeFace;
+  end;
+
+  { TFresnelSkiaFontEngine - singleton in the widgetset }
+
+  TFresnelSkiaFontEngine = class(TFresnelFontEngine)
+  private
+    FTypeFaces: TAvgLvlTree; // tree of TFresnelSkiaTypeFace sorted with CompareFresnelSkiaTypeFace
+    FFonts: TAvgLvlTree; // tree of TFresnelSkiaFont sorted with CompareFresnelSkiaFont
+  protected
+    procedure TypeFaceRefCount0(aTypeFace: TFresnelSkiaTypeFace);
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    function FindFont(const Desc: TFresnelFontDesc): TFresnelSkiaFont; virtual;
+    function FindTypeFace(const Desc: TFresnelFontDesc): TFresnelSkiaTypeFace; virtual;
+    function Allocate(const Desc: TFresnelFontDesc): IFresnelFont; override;
+    function TextSize(aFont: TFresnelSkiaFont; const aText: string): TFresnelPoint; virtual;
+    function TextSizeMaxWidth(aFont: TFresnelSkiaFont; const aText: string; const MaxWidth: TFresnelLength): TFresnelPoint; virtual;
+    class function GetFont(const FontIntf: IFresnelFont; out FreSkiaFont: TFresnelSkiaFont): boolean; virtual;
+  end;
+
+  { TFresnelSkiaRenderer - one instance per viewport }
+
+  TFresnelSkiaRenderer = class(TFresnelRenderer)
+  private
+    FCanvas: ISkCanvas;
+  protected
+    procedure FillRect(const aColor: TFPColor; const aRect: TFresnelRect); override;
+    procedure Line(const aColor: TFPColor; const x1, y1, x2, y2: TFresnelLength); override;
+    procedure TextOut(const aLeft, aTop: TFresnelLength;
+      const aFont: IFresnelFont; const aColor: TFPColor;
+      const aText: string); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    property Canvas: ISkCanvas read FCanvas write FCanvas;
+  end;
+
+function FPColorToSkia(const c: TFPColor): TAlphaColor;
+
+function CompareFresnelSkiaFont(Item1, Item2: Pointer): integer;
+function CompareFresnelSkiaTypeFace(Item1, Item2: Pointer): integer;
+function CompareFresnelFontDescWithSkiaFont(Key, Item: Pointer): integer;
+function CompareFresnelFontDescWithSkiaTypeFace(Key, Item: Pointer): integer;
+
+implementation
+
+function FPColorToSkia(const c: TFPColor): TAlphaColor;
+var
+  a: TAlphaColorRec;
+begin
+  a.R:=c.Red shr 8;
+  a.G:=c.Green shr 8;
+  a.B:=c.Blue shr 8;
+  a.A:=c.Alpha shr 8;
+  Result:=TAlphaColor(a);
+end;
+
+function CompareFresnelSkiaFont(Item1, Item2: Pointer): integer;
+var
+  Font1: TFresnelSkiaFont absolute Item1;
+  Font2: TFresnelSkiaFont absolute Item2;
+begin
+  Result:=CompareFresnelSkiaTypeFace(Font1.TypeFace,Font2.TypeFace);
+  if Result<>0 then exit;
+  Result:=CompareText(Font1.CSSSize,Font2.CSSSize);
+end;
+
+function CompareFresnelSkiaTypeFace(Item1, Item2: Pointer): integer;
+var
+  Face1: TFresnelSkiaTypeFace absolute Item1;
+  Face2: TFresnelSkiaTypeFace absolute Item2;
+begin
+  Result:=CompareText(Face1.CSSFamily,Face2.CSSFamily);
+  if Result<>0 then exit;
+  Result:=CompareText(Face1.CSSKerning,Face2.CSSKerning);
+  if Result<>0 then exit;
+  Result:=CompareText(Face1.CSSStyle,Face2.CSSStyle);
+  if Result<>0 then exit;
+  Result:=CompareText(Face1.CSSVariant_,Face2.CSSVariant_);
+  if Result<>0 then exit;
+  Result:=CompareText(Face1.CSSWeight,Face2.CSSWeight);
+end;
+
+function CompareFresnelFontDescWithSkiaFont(Key, Item: Pointer): integer;
+var
+  Desc: PFresnelFontDesc absolute Key;
+  aFont: TFresnelSkiaFont absolute Item;
+begin
+  Result:=CompareFresnelFontDescWithSkiaTypeFace(Key,aFont.TypeFace);
+  if Result<>0 then exit;
+  Result:=CompareText(Desc^.Size,aFont.CSSSize);
+end;
+
+function CompareFresnelFontDescWithSkiaTypeFace(Key, Item: Pointer): integer;
+var
+  Desc: PFresnelFontDesc absolute Key;
+  Face: TFresnelSkiaTypeFace absolute Item;
+begin
+  Result:=CompareText(Desc^.Family,Face.CSSFamily);
+  if Result<>0 then exit;
+  Result:=CompareText(Desc^.Kerning,Face.CSSKerning);
+  if Result<>0 then exit;
+  Result:=CompareText(Desc^.Style,Face.CSSStyle);
+  if Result<>0 then exit;
+  Result:=CompareText(Desc^.Variant_,Face.CSSVariant_);
+  if Result<>0 then exit;
+  Result:=CompareText(Desc^.Weight,Face.CSSWeight);
+end;
+
+{ TFresnelSkiaTypeFace }
+
+procedure TFresnelSkiaTypeFace.AddRef;
+begin
+  inc(FRefCount);
+end;
+
+procedure TFresnelSkiaTypeFace.Release;
+begin
+  if FRefCount=0 then
+    raise Exception.Create('TFresnelSkiaTypeFace.Release');
+  dec(FRefCount);
+  if FRefCount=0 then
+    Engine.TypeFaceRefCount0(Self);
+end;
+
+{ TFresnelSkiaFont }
+
+procedure TFresnelSkiaFont.SetTypeFace(const AValue: TFresnelSkiaTypeFace);
+begin
+  if FTypeFace=AValue then Exit;
+  if FTypeFace<>nil then
+    FTypeFace.Release;
+  FTypeFace:=AValue;
+  if FTypeFace<>nil then
+    FTypeFace.AddRef;
+end;
+
+destructor TFresnelSkiaFont.Destroy;
+begin
+  TypeFace:=nil;
+  inherited Destroy;
+end;
+
+function TFresnelSkiaFont.GetFamily: string;
+begin
+  Result:=TypeFace.CSSFamily;
+end;
+
+function TFresnelSkiaFont.GetKerning: string;
+begin
+  Result:=Typeface.CSSKerning;
+end;
+
+function TFresnelSkiaFont.GetSize: string;
+begin
+  Result:=CSSSize;
+end;
+
+function TFresnelSkiaFont.GetStyle: string;
+begin
+  Result:=TypeFace.CSSStyle;
+end;
+
+function TFresnelSkiaFont.GetVariant: string;
+begin
+  Result:=TypeFace.CSSVariant_;
+end;
+
+function TFresnelSkiaFont.GetWeight: string;
+begin
+  Result:=TypeFace.CSSWeight;
+end;
+
+function TFresnelSkiaFont.TextSize(const aText: string): TFresnelPoint;
+begin
+  Result:=Engine.TextSize(Self,aText);
+end;
+
+function TFresnelSkiaFont.TextSizeMaxWidth(const aText: string;
+  MaxWidth: TFresnelLength): TFresnelPoint;
+begin
+  Result:=Engine.TextSizeMaxWidth(Self,aText,MaxWidth);
+end;
+
+function TFresnelSkiaFont.GetTool: TObject;
+begin
+  Result:=Self;
+end;
+
+{ TFresnelSkiaFontEngine }
+
+procedure TFresnelSkiaFontEngine.TypeFaceRefCount0(
+  aTypeFace: TFresnelSkiaTypeFace);
+begin
+  FTypeFaces.Remove(aTypeFace);
+  aTypeFace.Free;
+end;
+
+constructor TFresnelSkiaFontEngine.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FFonts:=TAvgLvlTree.Create(@CompareFresnelSkiaFont);
+  FTypeFaces:=TAvgLvlTree.Create(@CompareFresnelSkiaTypeFace);
+end;
+
+destructor TFresnelSkiaFontEngine.Destroy;
+var
+  Node: TAvgLvlTreeNode;
+  aFont: TFresnelSkiaFont;
+begin
+  Node:=FFonts.Root;
+  while Node<>nil do
+  begin
+    aFont:=TFresnelSkiaFont(Node.Data);
+    Node.Data:=nil;
+    aFont._Release;
+    Node:=Node.Successor;
+  end;
+  FreeAndNil(FFonts);
+
+  FTypeFaces.FreeAndClear;
+  FreeAndNil(FTypeFaces);
+
+  inherited Destroy;
+end;
+
+function TFresnelSkiaFontEngine.FindFont(const Desc: TFresnelFontDesc
+  ): TFresnelSkiaFont;
+var
+  Node: TAvgLvlTreeNode;
+begin
+  Node:=FFonts.FindKey(@Desc,@CompareFresnelFontDescWithSkiaFont);
+  if Node=nil then
+    Result:=nil
+  else
+    Result:=TFresnelSkiaFont(Node.Data);
+end;
+
+function TFresnelSkiaFontEngine.FindTypeFace(const Desc: TFresnelFontDesc
+  ): TFresnelSkiaTypeFace;
+var
+  Node: TAvgLvlTreeNode;
+begin
+  Node:=FFonts.FindKey(@Desc,@CompareFresnelFontDescWithSkiaTypeFace);
+  if Node=nil then
+    Result:=nil
+  else
+    Result:=TFresnelSkiaTypeFace(Node.Data);
+end;
+
+function TFresnelSkiaFontEngine.Allocate(const Desc: TFresnelFontDesc
+  ): IFresnelFont;
+var
+  aFont: TFresnelSkiaFont;
+  aTypeFace: TFresnelSkiaTypeFace;
+begin
+  aFont:=FindFont(Desc);
+  if aFont<>nil then
+    exit(aFont);
+
+  aTypeFace:=FindTypeFace(Desc);
+  if aTypeFace=nil then
+  begin
+    aTypeFace:=TFresnelSkiaTypeFace.Create;
+    aTypeFace.CSSFamily:=Desc.Family;
+    aTypeFace.CSSKerning:=Desc.Kerning;
+    aTypeFace.CSSStyle:=Desc.Style;
+    aTypeFace.CSSVariant_:=Desc.Variant_;
+    aTypeFace.CSSWeight:=Desc.Weight;
+    FTypeFaces.Add(aTypeFace);
+    aTypeface.SKTypeFace := TSkTypeface.MakeFromName('Monospace', TSkFontStyle.Normal);
+  end;
+
+  aFont:=TFresnelSkiaFont.Create;
+  aFont.Engine:=Self;
+  aFont._AddRef;
+  aFont.CSSSize:=Desc.Size;
+  aFont.TypeFace:=aTypeFace;
+  FFonts.Add(aFont);
+  aFont.SKFont := TSkFont.Create(aTypeface.SKTypeFace, StrToIntDef(Desc.Size,8), 1);
+  aFont.SKFont.Edging := TSkFontEdging.AntiAlias;
+
+  Result:=aFont;
+end;
+
+function TFresnelSkiaFontEngine.TextSize(aFont: TFresnelSkiaFont;
+  const aText: string): TFresnelPoint;
+var
+  aRect: TRectF;
+begin
+  aFont.SKFont.MeasureText(UnicodeString(aText),aRect);
+  Result.X:=aRect.Width;
+  Result.Y:=aRect.Height;
+end;
+
+function TFresnelSkiaFontEngine.TextSizeMaxWidth(aFont: TFresnelSkiaFont;
+  const aText: string; const MaxWidth: TFresnelLength): TFresnelPoint;
+var
+  aRect: TRectF;
+begin
+  aFont.SKFont.MeasureText(UnicodeString(aText),aRect);
+  Result.X:=aRect.Width;
+  Result.Y:=aRect.Height;
+  if MaxWidth>Result.X then
+    raise Exception.Create('TFresnelSkiaFontEngine.TextSizeMaxWidth ToDo 20230917201535');
+end;
+
+class function TFresnelSkiaFontEngine.GetFont(const FontIntf: IFresnelFont; out
+  FreSkiaFont: TFresnelSkiaFont): boolean;
+var
+  Obj: TObject;
+begin
+  Result:=false;
+  FreSkiaFont:=nil;
+  if FontIntf=nil then exit;
+  Obj:=FontIntf.GetTool;
+  if Obj is TFresnelSkiaFont then
+  begin
+    FreSkiaFont:=TFresnelSkiaFont(Obj);
+    Result:=true;
+  end;
+end;
+
+{ TFresnelSkiaRenderer }
+
+procedure TFresnelSkiaRenderer.FillRect(const aColor: TFPColor;
+  const aRect: TFresnelRect);
+var
+  SkPaint: ISkPaint;
+  r: TRectF;
+begin
+  //DebugLn(['TFresnelSkiaRenderer.FillRect ',dbgs(aColor),' ',dbgs(aRect)]);
+  SkPaint:=TSkPaint.Create(TSkPaintStyle.Fill);
+  SkPaint.setColor(FPColorToSkia(aColor));
+  r:=aRect.GetRectF;
+  Canvas.DrawRect(r, SkPaint);
+end;
+
+procedure TFresnelSkiaRenderer.Line(const aColor: TFPColor; const x1, y1, x2,
+  y2: TFresnelLength);
+var
+  SkPaint: ISkPaint;
+begin
+  SkPaint:=TSkPaint.Create(TSkPaintStyle.Stroke);
+  SkPaint.setColor(FPColorToSkia(aColor));
+  Canvas.DrawLine(x1,y1,x2,y2, SkPaint);
+end;
+
+procedure TFresnelSkiaRenderer.TextOut(const aLeft, aTop: TFresnelLength;
+  const aFont: IFresnelFont; const aColor: TFPColor; const aText: string);
+var
+  FreSkiaFont: TFresnelSkiaFont;
+  SkPaint: ISkPaint;
+  aTextBlob: ISkTextBlob;
+begin
+  if not TFresnelSkiaFontEngine.GetFont(aFont,FreSkiaFont) then exit;
+  //debugln(['TFresnelSkiaRenderer.TextOut ',aLeft,',',aTop,' Col=',dbgs(aColor),' "',aText,'"']);
+  SkPaint:=TSkPaint.Create;
+  SkPaint.setColor(FPColorToSkia(aColor));
+  aTextBlob:=TSkTextBlob.MakeFromText(UnicodeString(aText),FreSkiaFont.SKFont);
+  Canvas.DrawTextBlob(aTextBlob, aLeft, aTop + FreSkiaFont.SKFont.Size, SkPaint);
+end;
+
+constructor TFresnelSkiaRenderer.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  SubPixel:=true;
+end;
+
+end.
+

src/skia/skia4delphi/LICENSE

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2021-2023 Skia4Delphi
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.