Browse Source

clean up and fixed tests suite

mattias 11 months ago
parent
commit
133d0720e7

+ 1 - 1
src/base/fcl-css/fpcssresparser.pas

@@ -33,7 +33,7 @@ uses
   Fcl.AVLTree, FPCss.Tree, FPCss.Scanner, FPCss.Parser;
 {$ELSE FPC_DOTTEDUNITS}
 uses
-  Classes, SysUtils, Math, Contnrs, AVL_Tree, System.UITypes, fpCSSTree, fpCSSScanner,
+  Classes, SysUtils, Math, Contnrs, AVL_Tree, fpCSSTree, fpCSSScanner,
   fpCSSParser;
 {$ENDIF FPC_DOTTEDUNITS}
 

+ 1 - 1
src/base/fresnel.classes.pas

@@ -24,7 +24,7 @@ unit Fresnel.Classes;
 interface
 
 uses
-  Classes, SysUtils, Math, Types, FpImage, System.UITypes, fpCSSScanner, fpCSSResParser;
+  Classes, SysUtils, Math, Types, FpImage, fpCSSScanner, fpCSSResParser;
 
 type
   {$IF FPC_FULLVERSION<30301}

+ 1 - 1
src/base/fresnel.controls.pas

@@ -23,7 +23,7 @@ unit Fresnel.Controls;
 interface
 
 uses
-  Classes, SysUtils, Math, fpCSSResolver, fpCSSTree, fpCSSResParser,
+  Classes, SysUtils, Math, fpCSSTree, fpCSSResParser,
   fpImage, fresnel.images,
   Fresnel.Classes, Fresnel.Dom;
 

+ 36 - 2
src/base/fresnel.dom.pas

@@ -397,6 +397,7 @@ type
     procedure SplitFont(Resolver: TCSSBaseResolver; var AttrIDs: TCSSNumericalIDArray; var Values: TCSSStringArray); virtual; // todo systemfont
     procedure SplitMargin(Resolver: TCSSBaseResolver; var AttrIDs: TCSSNumericalIDArray; var Values: TCSSStringArray); virtual;
     procedure SplitMarginBlock(Resolver: TCSSBaseResolver; var AttrIDs: TCSSNumericalIDArray; var Values: TCSSStringArray); virtual;
+    procedure SplitMarginInline(Resolver: TCSSBaseResolver; var AttrIDs: TCSSNumericalIDArray; var Values: TCSSStringArray); virtual;
     procedure SplitPadding(Resolver: TCSSBaseResolver; var AttrIDs: TCSSNumericalIDArray; var Values: TCSSStringArray); virtual;
     procedure SplitBackgroundPosition(Resolver: TCSSBaseResolver; var AttrIDs: TCSSNumericalIDArray; var Values: TCSSStringArray); virtual;
     procedure SplitBackground(Resolver: TCSSBaseResolver; var AttrIDs: TCSSNumericalIDArray; var Values: TCSSStringArray); virtual;
@@ -813,8 +814,7 @@ type
     property Parent: TFresnelElement read FParent write SetParent;
     property NodeCount: integer read GetNodeCount;
     property Nodes[Index: integer]: TFresnelElement read GetNodes; default;
-    property Resolver: TCSSResolver read FResolver;
-    // CSS
+    // CSS and implementation of ICSSNode
     class function CSSTypeID: TCSSNumericalID; virtual; abstract;
     class function CSSTypeName: TCSSString; virtual; abstract;
     class function GetCSSTypeStyle: TCSSString; virtual;
@@ -897,6 +897,8 @@ type
     property EventDispatcher : TFresnelEventDispatcher Read FEventDispatcher;
     // font
     property Font: IFresnelFont read GetFont write FFont;
+    //
+    property Resolver: TCSSResolver read FResolver;
     property ViewportConnected: boolean read GetViewportConnected write SetViewportConnected; // true for example if using a Font of Viewport
     property Viewport: TFresnelViewport read FViewPort;
   published
@@ -2475,6 +2477,31 @@ begin
     Values[1]:=Found[0];
 end;
 
+procedure TFresnelCSSRegistry.SplitMarginInline(Resolver: TCSSBaseResolver;
+  var AttrIDs: TCSSNumericalIDArray; var Values: TCSSStringArray);
+var
+  Found: TCSSStringArray;
+begin
+  Found:=[];
+  repeat
+    if Chk_Margin_Dim.Fits(Resolver.CurComp) or (Resolver.CurComp.Kind=rvkFunction) then
+      Insert(Resolver.GetCompString,Found,length(Found));
+    if length(Found)=2 then break;
+  until not Resolver.ReadNext;
+
+  if length(Found)=0 then exit;
+
+  SetLength(AttrIDs,2);
+  SetLength(Values,2);
+  AttrIDs[0]:=FresnelAttrs[fcaMarginInlineStart].Index;
+  AttrIDs[1]:=FresnelAttrs[fcaMarginInlineEnd].Index;
+  Values[0]:=Found[0];
+  if length(Found)=2 then
+    Values[1]:=Found[1]
+  else
+    Values[1]:=Found[0];
+end;
+
 procedure TFresnelCSSRegistry.SplitPadding(Resolver: TCSSBaseResolver;
   var AttrIDs: TCSSNumericalIDArray; var Values: TCSSStringArray);
 var
@@ -2908,6 +2935,12 @@ begin
   AddFresnelShorthand(fcaMarginBlock,@CheckMargin,@SplitMarginBlock,
     [fcaMarginBlockStart,fcaMarginBlockEnd]);
 
+  // margin-inline
+  AddFresnelLonghand(fcaMarginInlineEnd,false,@CheckMargin,'0');
+  AddFresnelLonghand(fcaMarginInlineStart,false,@CheckMargin,'0');
+  AddFresnelShorthand(fcaMarginInline,@CheckMargin,@SplitMarginInline,
+    [fcaMarginInlineStart,fcaMarginInlineEnd]);
+
   // opacity
   AddFresnelLonghand(fcaOpacity,false,@CheckOpacity,'1');
   Chk_Opacity_Dim.AllowedUnits:=[cuNone,cuPercent];
@@ -4326,6 +4359,7 @@ begin
   writeln('TFresnelElement.WriteComputedAttributes ',Title,' ',GetPath,'================');
   for Attr in TFresnelCSSAttribute do
   begin
+    writeln('TFresnelElement.WriteComputedAttributes ',Attr);
     CurValue:=GetComputedString(Attr);
     DefValue:=GetUnsetCSSString(Attr);
     if CurValue<>DefValue then

+ 1 - 1
src/base/fresnel.forms.pas

@@ -20,7 +20,7 @@ unit Fresnel.Forms;
 interface
 
 uses
-  Classes, SysUtils, Math, CustApp, fpCSSResolver, fpCSSTree, Contnrs,
+  Classes, SysUtils, Math, CustApp, fpCSSTree, Contnrs,
   Fresnel.StrConsts, Fresnel.Classes, Fresnel.Resources,
   Fresnel.DOM, Fresnel.Renderer, Fresnel.Layouter, Fresnel.WidgetSet,
   Fresnel.Events, FCL.Events, Fresnel.AsyncCalls;

+ 4 - 5
src/base/fresnel.textlayouter.pas

@@ -13,7 +13,7 @@ uses
 {$IFDEF FPC_DOTTEDUNITS}
   System.Classes, System.SysUtils, System.Types, System.Contnrs, fpImage, System.UITypes;
 {$ELSE}
-  Classes, SysUtils, Types, Fresnel.Classes, Contnrs, fpImage, System.UITypes;
+  Classes, SysUtils, Fresnel.Classes, Contnrs, fpImage, System.UITypes;
 {$ENDIF}
 
 Const
@@ -1231,7 +1231,6 @@ var
   aPos : sizeInt;
   SplitPos : TTextSplitPoint;
   B,BN : TTextBlock;
-  T : String;
 
 begin
   I:=0;
@@ -1239,17 +1238,17 @@ begin
     begin
     B:=FBlocks[i];
     Repeat
-      T:=B.Text;
+      //T:=B.Text;
       SplitPos:=Splitter.GetNextNewLine(Text,1+B.TextOffset);
       if SplitPos.Offset<>-1 then
         begin
         aPos:=Splitpos.offset+Splitpos.whitespace;
         BN:=B.Split(aPos);
-        T:=BN.Text;
+        //T:=BN.Text;
         BN.ForceNewLine:=True;
         B.TextLen:=B.TextLen-SplitPos.WhiteSpace;
         B.TrimTrailingWhiteSpace;
-        T:=B.Text;
+        //T:=B.Text;
         inc(I);
         FBlocks.Insert(I,BN);
         B:=BN;

+ 23 - 4
tests/base/TCFresnelCSS.pas

@@ -37,7 +37,6 @@ type
     function TextSize(const aText: string): TFresnelPoint;
     function TextSizeMaxWidth(const aText: string; MaxWidth: TFresnelLength): TFresnelPoint;
     function GetTool: TObject;
-
   end;
 
   { TTestFontEngine }
@@ -56,15 +55,17 @@ type
   { TTestRenderer }
 
   TTestRenderer = class(TFresnelRenderer)
-  private
-  protected
+  public
+    procedure Arc(const aColor: TFPColor; const aCenter, aRadii: TFresnelPoint;
+      aStartAngle: TFresnelLength=0; aStopAngle: TFresnelLength=DoublePi); override;
     procedure FillRect(const aColor: TFPColor; const aRect: TFresnelRect); override;
     procedure Line(const aColor: TFPColor; const x1, y1, x2, y2: TFresnelLength); override;
+    procedure RoundRect(const aColor: TFPColor; const aRect: TFresnelRoundRect; Fill: Boolean);
+      override;
     procedure TextOut(const aLeft, aTop: TFresnelLength;
       const aFont: IFresnelFont; const aColor: TFPColor;
       const aText: string); override;
     procedure DrawImage(const aLeft, aTop, aWidth, aHeight: TFresnelLength; const aImage: TFPCustomImage); override;
-  public
     constructor Create(AOwner: TComponent); override;
   end;
 
@@ -381,6 +382,16 @@ end;
 
 { TTestRenderer }
 
+procedure TTestRenderer.Arc(const aColor: TFPColor; const aCenter, aRadii: TFresnelPoint;
+  aStartAngle: TFresnelLength; aStopAngle: TFresnelLength);
+begin
+  if aColor=colBlack then;
+  if aCenter.X=0 then ;
+  if aRadii.X=0 then;
+  if aStartAngle=0 then;
+  if aStopAngle=0 then;
+end;
+
 procedure TTestRenderer.FillRect(const aColor: TFPColor;
   const aRect: TFresnelRect);
 begin
@@ -395,6 +406,14 @@ begin
   if x1+y1+x2+y2=0 then ;
 end;
 
+procedure TTestRenderer.RoundRect(const aColor: TFPColor; const aRect: TFresnelRoundRect;
+  Fill: Boolean);
+begin
+  if aColor=colBlack then;
+  if aRect.Box.Left=0 then;
+  if Fill then;
+end;
+
 procedure TTestRenderer.TextOut(const aLeft, aTop: TFresnelLength;
   const aFont: IFresnelFont; const aColor: TFPColor; const aText: string);
 begin

+ 1 - 1
tests/base/TestFresnelBase.lpi

@@ -4,7 +4,6 @@
     <Version Value="12"/>
     <General>
       <Flags>
-        <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>
@@ -73,6 +72,7 @@
       <Unit>
         <Filename Value="tctextlayout.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="TCTextLayout"/>
       </Unit>
     </Units>
   </ProjectOptions>

+ 1 - 1
tests/base/TestFresnelBase.lpr

@@ -11,7 +11,7 @@ program TestFresnelBase;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, consoletestrunner, TCFresnelCSS, TCFresnelBaseEvents, TCFresnelImages, tcTextLayout;
+  Classes, consoletestrunner, TCFresnelCSS, TCFresnelBaseEvents, TCFresnelImages, TCTextLayout;
 
 type
 

+ 3 - 3
tests/base/tctextlayout.pas

@@ -1,11 +1,11 @@
-unit tctextlayout;
+unit TCTextLayout;
 
 {$mode objfpc}{$H+}
 
 interface
 
 uses
-  Classes, SysUtils, types, fpcunit, testutils, testregistry, fpimage, fresnel.textlayouter;
+  Classes, SysUtils, fpcunit, testregistry, fpimage, fresnel.textlayouter;
 
 const
   cHeight = 15;
@@ -324,7 +324,7 @@ begin
   With aBlock do
     begin
     ForceNewLine:=True;
-    LayoutPos:=PointF(2,3);
+    LayoutPos:=TTextPoint.Create(2,3);
     Size.Width:=12.3;
     Size.Height:=8.9;
     Size.Descender:=2.3;