tests: empty viewport

src/base/fresnel.dom.pas

@@ -262,6 +262,8 @@ type
   end;
   IFLFont = IFresnelFont;
 
+  { TFresnelFontDesc - font descriptor }
+
   TFresnelFontDesc = record
     Family: string;
     Kerning: string;
@@ -269,6 +271,8 @@ type
     Style: string;
     Variant_: string;
     Weight: string;
+    function Compare(const Desc: TFresnelFontDesc): integer;
+    class function CompareDescriptors(const A, B: TFresnelFontDesc): integer; static;
   end;
   PFresnelFontDesc = ^TFresnelFontDesc;
 
@@ -559,9 +563,10 @@ type
     procedure ClearCSSValues; override;
     procedure DomChanged; override;
     function AllocateFont(const Desc: TFresnelFontDesc): IFresnelFont; virtual;
+    function GetCSSInitialAttribute(const AttrID: TCSSNumericalID): TCSSString; override;
     function GetElementAt(const x, y: TFresnelLength): TFresnelElement; virtual;
-    function ContentToPagePos(El: TFresnelElement; const x, y: TFresnelLength): TFresnelPoint; virtual;
-    function PageToContentPos(El: TFresnelElement; const x, y: TFresnelLength): TFresnelPoint; virtual;
+    function ContentToPagePos(El: TFresnelElement; const x, y: TFresnelLength): TFresnelPoint; virtual; // content box of El to content of viewport
+    function PageToContentPos(El: TFresnelElement; const x, y: TFresnelLength): TFresnelPoint; virtual; // content of viewport to content box of El
     property DPI[IsHorizontal: boolean]: TFresnelLength read GetDPI write SetDPI;
     property FontMinSize: TFresnelLength read FFontMinSize write SetFontMinSize;
     property ScrollbarWidth[IsHorizontal: boolean]: TFresnelLength read GetScrollbarWidth write SetScrollbarWidth;
@@ -926,6 +931,29 @@ begin
   FNodes.Sort(Compare,Context,SortBase.DefaultSortingAlgorithm);
 end;
 
+{ TFresnelFontDesc }
+
+function TFresnelFontDesc.Compare(const Desc: TFresnelFontDesc): integer;
+begin
+  Result:=CompareText(Family,Desc.Family);
+  if Result<>0 then exit;
+  Result:=CompareText(Kerning,Desc.Kerning);
+  if Result<>0 then exit;
+  Result:=CompareText(Size,Desc.Size);
+  if Result<>0 then exit;
+  Result:=CompareText(Style,Desc.Style);
+  if Result<>0 then exit;
+  Result:=CompareText(Variant_,Desc.Variant_);
+  if Result<>0 then exit;
+  Result:=CompareText(Weight,Desc.Weight);
+end;
+
+class function TFresnelFontDesc.CompareDescriptors(const A, B: TFresnelFontDesc
+  ): integer;
+begin
+  Result:=A.Compare(B);
+end;
+
 { TFresnelViewport }
 
 procedure TFresnelViewport.CSSResolverLog(Sender: TObject;
@@ -1188,6 +1216,22 @@ begin
     raise EFresnelFont.Create('TFresnelViewport.AllocateFont no FontEngine');
 end;
 
+function TFresnelViewport.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;
+
 function TFresnelViewport.GetElementAt(const x, y: TFresnelLength
   ): TFresnelElement;
 

src/base/fresnel.forms.pas

@@ -78,7 +78,6 @@ type
     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
@@ -361,6 +360,7 @@ end;
 procedure TCustomFresnelForm.DomChanged;
 begin
   LayoutQueued:=true;
+  inherited DomChanged;
 end;
 
 procedure TCustomFresnelForm.Hide;
@@ -403,22 +403,6 @@ begin
     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;

tests/base/.gitignore

@@ -0,0 +1 @@
+TestFresnelBase

tests/base/TCFresnelCSS.pas

@@ -16,10 +16,72 @@ unit TCFresnelCSS;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testregistry;
+  Classes, SysUtils, Math, fpcunit, testregistry, FpImage, Fresnel.DOM,
+  Fresnel.Renderer, Fresnel.Layouter, Fresnel.Classes, AvgLvlTree, LazUTF8;
 
 type
 
+  { TTestFont }
+
+  TTestFont = class(TInterfacedObject,IFresnelFont)
+  public
+    Desc: TFresnelFontDesc;
+    function GetFamily: string;
+    function GetKerning: string;
+    function GetSize: string;
+    function GetStyle: string;
+    function GetVariant: string;
+    function GetWeight: string;
+    function TextSize(const aText: string): TFresnelPoint;
+    function TextSizeMaxWidth(const aText: string; MaxWidth: TFresnelLength): TFresnelPoint;
+    function GetTool: TObject;
+  end;
+
+  { TTestFontEngine }
+
+  TTestFontEngine = class(TFresnelFontEngine)
+  private
+    FFonts: TAvgLvlTree; // tree of TTestFont sorted with CompareTestFont
+  protected
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    function FindFont(const Desc: TFresnelFontDesc): TTestFont; virtual;
+    function Allocate(const Desc: TFresnelFontDesc): IFresnelFont; override;
+  end;
+
+  { TTestRenderer }
+
+  TTestRenderer = class(TFresnelRenderer)
+  private
+  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;
+  end;
+
+  { TTestViewport }
+
+  TTestViewport = class(TFresnelViewport)
+  private
+    FLayoutQueued: boolean;
+    FRenderer: TFresnelRenderer;
+  protected
+    procedure SetWidth(AValue: TFresnelLength); override;
+    procedure SetHeight(AValue: TFresnelLength); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure DomChanged; override;
+    procedure Draw; virtual;
+    property LayoutQueued: boolean read FLayoutQueued write FLayoutQueued;
+    property Renderer: TFresnelRenderer read FRenderer write FRenderer;
+  end;
+
   { TCustomTestFresnelCSS }
 
   TCustomTestFresnelCSS = Class(TTestCase)
@@ -27,6 +89,7 @@ type
     procedure SetUp; override;
     procedure TearDown; override;
   public
+    Viewport: TTestViewport;
   end;
 
   { TTestFresnelCSS }
@@ -38,15 +101,359 @@ type
 
 implementation
 
+const
+  // char sizes for a font size of 100
+  CharHeight = 115;
+  CharWidths: array[32..126] of word = (
+    278, // space
+    278, // !
+    355, // "
+    556, // #
+    556, // $
+    889, // %
+    667, // &
+    191, // '
+    333, // (
+    333, // )
+    389, // *
+    584, // +
+    278, // ,
+    333, // -
+    278, // .
+    278, // /
+    556, // 0
+    489, // 1
+    556, // 2
+    556, // 3
+    556, // 4
+    556, // 5
+    556, // 6
+    556, // 7
+    556, // 8
+    556, // 9
+    278, // :
+    278, // ;
+    584, // <
+    584, // =
+    584, // >
+    556, // ?
+    1015, // @
+    667, // A
+    667, // B
+    722, // C
+    722, // D
+    667, // E
+    611, // F
+    778, // G
+    722, // H
+    278, // I
+    500, // J
+    667, // K
+    556, // L
+    833, // M
+    722, // N
+    778, // O
+    667, // P
+    778, // Q
+    722, // R
+    667, // S
+    611, // T
+    722, // U
+    667, // V
+    944, // W
+    667, // X
+    667, // Y
+    611, // Z
+    278, // [
+    278, // \
+    278, // ]
+    469, // ^
+    556, // _
+    333, // `
+    556, // a
+    556, // b
+    500, // c
+    556, // d
+    556, // e
+    262, // f
+    556, // g
+    556, // h
+    222, // i
+    222, // j
+    500, // k
+    222, // l
+    833, // m
+    556, // n
+    556, // o
+    556, // p
+    556, // q
+    333, // r
+    500, // s
+    278, // t
+    556, // u
+    500, // v
+    722, // w
+    500, // x
+    500, // y
+    500, // z
+    334, // {
+    260, // |
+    334, // }
+    584  // ~
+    );
+
+function CompareTestFont(Desc1, Desc2: Pointer): integer;
+var
+  A: PFresnelFontDesc absolute Desc1;
+  B: PFresnelFontDesc absolute Desc2;
+begin
+  Result:=A^.Compare(B^);
+end;
+
+function CompareFontDescTestFont(aDesc, aFont: Pointer): integer;
+var
+  Desc: PFresnelFontDesc absolute aDesc;
+  Font: TTestFont absolute aFont;
+begin
+  Result:=Desc^.Compare(Font.Desc);
+end;
+
+{ TTestFont }
+
+function TTestFont.GetFamily: string;
+begin
+  Result:=Desc.Family;
+end;
+
+function TTestFont.GetKerning: string;
+begin
+  Result:=Desc.Kerning;
+end;
+
+function TTestFont.GetSize: string;
+begin
+  Result:=Desc.Size;
+end;
+
+function TTestFont.GetStyle: string;
+begin
+  Result:=Desc.Style;
+end;
+
+function TTestFont.GetVariant: string;
+begin
+  Result:=Desc.Variant_;
+end;
+
+function TTestFont.GetWeight: string;
+begin
+  Result:=Desc.Weight;
+end;
+
+function TTestFont.TextSize(const aText: string): TFresnelPoint;
+begin
+  Result:=TextSizeMaxWidth(aText,1000000);
+end;
+
+function TTestFont.TextSizeMaxWidth(const aText: string;
+  MaxWidth: TFresnelLength): TFresnelPoint;
+var
+  aSize, CurLineWidth, CurLineHeight: TFresnelLength;
+  CodepointLen: Integer;
+  p: PChar;
+  CodePoint: Cardinal;
+
+  procedure AddLineBreak;
+  begin
+    if CurLineWidth>Result.X then
+      Result.X:=CurLineWidth;
+    CurLineWidth:=0;
+    Result.Y:=Result.Y+CurLineHeight;
+  end;
+
+  procedure AddChar(CharWidth: TFresnelLength);
+  begin
+    if (CurLineWidth>0) and (CurLineWidth+CharWidth>MaxWidth) then
+      AddLineBreak;
+    CurLineWidth:=CurLineWidth+CharWidth;
+  end;
+
+begin
+  aSize:=StrToFloat(Desc.Size);
+  if aSize<0 then
+    raise EFresnelFont.Create('font size negative "'+Desc.Size+'"');
+  Result.X:=0;
+  Result.Y:=0;
+  if (aText='') or (SameValue(aSize,0)) then
+    exit;
+  CurLineHeight:=aSize*CharHeight/100;
+  Result.Y:=CurLineHeight;
+  p:=PChar(aText);
+  CurLineWidth:=0;
+  while p^<>#0 do
+  begin
+    CodePoint:=ord(p^);
+    case CodePoint of
+    0: break;
+    10,13:
+      begin
+        AddLineBreak;
+        if (p[1] in [#10,#13]) and (CodePoint<>ord(p[1])) then
+          inc(p,2)
+        else
+          inc(p);
+      end;
+    32..126:
+      begin
+        AddChar(aSize*CharWidths[CodePoint]/100);
+        inc(p);
+      end
+    else
+      CodePoint:=UTF8CodepointToUnicode(p,CodepointLen);
+      AddChar(aSize*CharWidths[65]/100);
+      inc(p,CodepointLen);
+    end;
+  end;
+  if CurLineWidth>Result.X then
+    Result.X:=CurLineWidth;
+end;
+
+function TTestFont.GetTool: TObject;
+begin
+  Result:=Self;
+end;
+
+{ TTestFontEngine }
+
+constructor TTestFontEngine.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FFonts:=TAvgLvlTree.Create(@CompareTestFont);
+end;
+
+destructor TTestFontEngine.Destroy;
+begin
+  FFonts.FreeAndClear;
+  FreeAndNil(FFonts);
+
+  inherited Destroy;
+end;
+
+function TTestFontEngine.FindFont(const Desc: TFresnelFontDesc): TTestFont;
+var
+  Node: TAvgLvlTreeNode;
+begin
+  Node:=FFonts.FindKey(@Desc,@CompareFontDescTestFont);
+  if Node=nil then
+    Result:=nil
+  else
+    Result:=TTestFont(Node.Data);
+end;
+
+function TTestFontEngine.Allocate(const Desc: TFresnelFontDesc): IFresnelFont;
+var
+  aFont: TTestFont;
+begin
+  aFont:=FindFont(Desc);
+  if aFont=nil then
+  begin
+    aFont:=TTestFont.Create;
+    aFont.Desc:=Desc;
+    FFonts.Add(aFont);
+  end;
+  Result:=aFont;
+end;
+
+{ TTestRenderer }
+
+procedure TTestRenderer.FillRect(const aColor: TFPColor;
+  const aRect: TFresnelRect);
+begin
+  if aColor=colBlack then ;
+  if aRect.IsEmpty then ;
+end;
+
+procedure TTestRenderer.Line(const aColor: TFPColor; const x1, y1, x2,
+  y2: TFresnelLength);
+begin
+  if aColor=colBlack then ;
+  if x1+y1+x2+y2=0 then ;
+end;
+
+procedure TTestRenderer.TextOut(const aLeft, aTop: TFresnelLength;
+  const aFont: IFresnelFont; const aColor: TFPColor; const aText: string);
+begin
+  if aLeft=aTop then ;
+  if aFont=nil then ;
+  if aColor=colBlack then  ;
+  if aText='' then ;
+end;
+
+constructor TTestRenderer.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+end;
+
+{ TTestViewport }
+
+procedure TTestViewport.SetWidth(AValue: TFresnelLength);
+begin
+  inherited SetWidth(AValue);
+  LayoutQueued:=true;
+end;
+
+procedure TTestViewport.SetHeight(AValue: TFresnelLength);
+begin
+  inherited SetHeight(AValue);
+  LayoutQueued:=true;
+end;
+
+constructor TTestViewport.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  Layouter:=TViewportLayouter.Create(nil);
+  TViewportLayouter(Layouter).Viewport:=Self;
+  Renderer:=TTestRenderer.Create(Self);
+end;
+
+destructor TTestViewport.Destroy;
+begin
+  FreeAndNil(FRenderer);
+  Layouter.Free;
+  Layouter:=nil;
+  inherited Destroy;
+end;
+
+procedure TTestViewport.DomChanged;
+begin
+  LayoutQueued:=true;
+  inherited DomChanged;
+end;
+
+procedure TTestViewport.Draw;
+begin
+  //debugln(['TTestViewport.WSDraw ',DbgSName(Self),' ',DbgSName(Renderer)]);
+  if LayoutQueued then
+  begin
+    LayoutQueued:=false;
+    ApplyCSS;
+    //Layouter.WriteLayoutTree;
+    Layouter.Apply(Self);
+  end;
+  Renderer.Draw(Self);
+end;
+
 { TCustomTestFresnelCSS }
 
 procedure TCustomTestFresnelCSS.SetUp;
 begin
   inherited SetUp;
+  Viewport:=TTestViewport.Create(nil);
 end;
 
 procedure TCustomTestFresnelCSS.TearDown;
 begin
+  FreeAndNil(Viewport);
   inherited TearDown;
 end;
 
@@ -54,7 +461,7 @@ end;
 
 procedure TTestFresnelCSS.TestEmptyViewport;
 begin
-
+  Viewport.Draw;
 end;
 
 Initialization