{ ***************************************************************************** This file is part of Fresnel. See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** Examples: ./testfresnelbase --suite=TTestFresnelCSS.TestEmptyViewport } unit TCFresnelCSS; {$mode ObjFPC}{$H+} interface uses Classes, SysUtils, Math, fpcunit, testregistry, FpImage, Fresnel.DOM, Fresnel.Renderer, Fresnel.Layouter, Fresnel.Classes, Fresnel.Controls, Avl_Tree, UTF8Utils; type { TTestFont } TTestFont = class(TInterfacedObject,IFresnelFont) public Desc: TFresnelFontDesc; function GetAlternates: string; function GetCaps: TFresnelCSSFontVarCaps; function GetDescription: String; function GetEastAsians: TFresnelCSSFontVarEastAsians; function GetEmoji: TFresnelCSSFontVarEmoji; function GetFamily: string; function GetKerning: TFresnelCSSKerning; function GetLigatures: TFresnelCSSFontVarLigaturesSet; function GetNumerics: TFresnelCSSFontVarNumerics; function GetPosition: TFresnelCSSFontVarPosition; function GetSize: double; function GetStyle: string; function GetWidth: double; function GetWeight: double; function TextSize(const aText: string): TFresnelPoint; function TextSizeMaxWidth(const aText: string; MaxWidth: TFresnelLength): TFresnelPoint; function GetTool: TObject; end; { TTestFontEngine } TTestFontEngine = class(TFresnelFontEngine) private FFonts: TAVLTree; // 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) protected FSavedContexts: TFresnelRectDynArray; public ClipR: TFresnelRect; procedure Arc(const aColor: TFPColor; const aCenter, aRadii: TFresnelPoint; aStartAngle: TFresnelLength=0; aStopAngle: TFresnelLength=Tau); override; procedure ClipRect(const aRect: TFresnelRect); override; procedure FillRect(const aColor: TFPColor; const aRect: TFresnelRect); override; procedure Line(const aColor: TFPColor; const x1, y1, x2, y2: TFresnelLength); override; procedure Polygon(const aColor: TFPColor; const p: PFresnelPoint; Count: integer); override; procedure Restore; override; procedure RoundRect(const aColor: TFPColor; const aRect: TFresnelRoundRect; Fill: Boolean); override; procedure Save; 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; constructor Create(AOwner: TComponent); override; end; { TTestViewport } TTestViewport = class(TFresnelViewport) private fDrawing: Boolean; 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; function IsDrawing: boolean; override; property LayoutQueued: boolean read FLayoutQueued write FLayoutQueued; property Renderer: TFresnelRenderer read FRenderer write FRenderer; end; { TCustomTestFresnelCSS } TCustomTestFresnelCSS = Class(TTestCase) protected procedure SetUp; override; procedure TearDown; override; public Viewport: TTestViewport; end; { TTestFresnelCSS } TTestFresnelCSS = class(TCustomTestFresnelCSS) published procedure TestEmptyViewport; procedure TestBody; procedure TestGetStyleAttr_OneValue; procedure TestGetStyleAttr_TwoValues; procedure TestGetStyleAttr_OneFunction; procedure TestGetStyleAttr_TwoFunctions; procedure TestGetStyleAttr_NestedFunctions; procedure TestSetStyleAttr_NewValueEmpty; procedure TestSetStyleAttr_NewValueFirst; procedure TestSetStyleAttr_NewValueAppend; procedure TestSetStyleAttr_NewValueAppendSemicolon; procedure TestSetStyleAttr_DeleteOnlyValue; procedure TestSetStyleAttr_DeleteFirstValue; procedure TestSetStyleAttr_DeleteLastValue; procedure TestSetStyleAttr_DeleteMiddleValue; procedure TestSetStyleAttr_ReplaceOnlyValue; procedure TestSetStyleAttr_ReplaceFirstValue; procedure TestSetStyleAttr_ReplaceLastValue; procedure TestSetStyleAttr_ReplaceMiddleValue; procedure Test_FontSize_Percentage; procedure Test_FontSize_AsString; procedure Test_Font_AsString; procedure Test_Overflow_AsString; procedure Test_BorderColor_AsString; procedure Test_BorderStyle_AsString; procedure Test_BorderWidth_AsString; procedure Test_Border_AsString; procedure Test_BorderRadius_AsString; procedure Test_Margin_AsString; procedure Test_MarginBlock_AsString; // todo //procedure Test_MarginInline_AsString; // todo procedure Test_Padding_AsString; procedure Test_BackgroundPosition_AsString; // todo: Test_Gap_AsString // todo: Test_PlaceContent_AsString // todo: Test_PlaceItems_AsString // todo: Test_PlaceSelf_AsString procedure TestVar_NoDefault; procedure TestVar_Initial; procedure TestVar_Inline; end; function LinesToStr(const Args: array of const): string; implementation const // char sizes for a font size of 1000 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: TTestFont absolute Desc1; B: TTestFont absolute Desc2; begin Result:=A.Desc.Compare(B.Desc); end; function CompareFontDescTestFont(aDesc, aFont: Pointer): integer; var Desc: PFresnelFontDesc absolute aDesc; Font: TTestFont absolute aFont; begin Result:=Desc^.Compare(Font.Desc); end; function LinesToStr(const Args: array of const): string; var s: String; i: Integer; begin s:=''; for i:=Low(Args) to High(Args) do begin case Args[i].VType of vtChar: s += Args[i].VChar+LineEnding; vtString: s += Args[i].VString^+LineEnding; vtPChar: s += Args[i].VPChar+LineEnding; vtWideChar: s += String(Args[i].VWideChar)+LineEnding; vtPWideChar: s += String(Args[i].VPWideChar)+LineEnding; vtAnsiString: s += AnsiString(Args[i].VAnsiString)+LineEnding; // FPC uses encoding CP_UTF8 for TVarRec.VAnsiString vtWidestring: s += String(WideString(Args[i].VWideString))+LineEnding; vtUnicodeString:s += String(UnicodeString(Args[i].VUnicodeString))+LineEnding; end; end; Result:=s; end; { TTestFont } function TTestFont.GetFamily: string; begin Result:=Desc.Family; end; function TTestFont.GetDescription: String; begin Result:=Desc.Family; end; function TTestFont.GetAlternates: string; begin Result:=''; end; function TTestFont.GetCaps: TFresnelCSSFontVarCaps; begin Result:=ffvcNormal; end; function TTestFont.GetEastAsians: TFresnelCSSFontVarEastAsians; begin Result:=[ffveaNormal]; end; function TTestFont.GetEmoji: TFresnelCSSFontVarEmoji; begin Result:=ffveNormal; end; function TTestFont.GetKerning: TFresnelCSSKerning; begin Result:=Desc.Kerning; end; function TTestFont.GetLigatures: TFresnelCSSFontVarLigaturesSet; begin Result:=[ffvlNormal]; end; function TTestFont.GetNumerics: TFresnelCSSFontVarNumerics; begin Result:=[ffvnNormal]; end; function TTestFont.GetPosition: TFresnelCSSFontVarPosition; begin Result:=ffvpNormal; end; function TTestFont.GetSize: double; begin Result:=Desc.Size; end; function TTestFont.GetStyle: string; begin Result:=Desc.Style; end; function TTestFont.GetWidth: double; begin Result:=Desc.Width; end; function TTestFont.GetWeight: double; 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:=Desc.Size; if aSize<0 then raise EFresnelFont.CreateFmt('font size negative "%g"',[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; CodepointLen:=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]/1000); inc(p); end else {$IFNDEF CPUWASM} CodePoint:=UTF8CodepointToUnicode(p,CodepointLen); {$ELSE} CodePoint:=0; {$ENDIF} AddChar(aSize*CharWidths[65]/1000); 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:=TAVLTree.Create(@CompareTestFont); end; destructor TTestFontEngine.Destroy; begin FFonts.FreeAndClear; FreeAndNil(FFonts); inherited Destroy; end; function TTestFontEngine.FindFont(const Desc: TFresnelFontDesc): TTestFont; var Node: TAVLTreeNode; 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.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.ClipRect(const aRect: TFresnelRect); begin ClipR:=aRect; end; 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.Polygon(const aColor: TFPColor; const p: PFresnelPoint; Count: integer); begin if aColor=colBlack then ; if Count=0 then ; if p=nil then ; end; procedure TTestRenderer.Restore; var l: SizeInt; begin l:=Length(FSavedContexts)-1; if l<0 then raise Exception.Create('20250429101125 TTestRenderer.Restore'); ClipR:=FSavedContexts[l]; SetLength(FSavedContexts,l); 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.Save; var l: SizeInt; begin l:=Length(FSavedContexts); SetLength(FSavedContexts,l+1); FSavedContexts[l]:=ClipR; 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; procedure TTestRenderer.DrawImage(const aLeft, aTop, aWidth, aHeight: TFresnelLength; const aImage: TFPCustomImage); begin if (aLeft=aTop) then ; if (aWidth=aHeight) then ; if (aImage=nil) 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; FontEngine:=TTestFontEngine.Create(Self); Renderer:=TTestRenderer.Create(Self); DomChanged; end; destructor TTestViewport.Destroy; begin FreeAndNil(FRenderer); FontEngine.Free; FontEngine:=nil; 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 fDrawing then raise Exception.Create('20250429140551'); fDrawing:=true; if LayoutQueued then begin LayoutQueued:=false; ApplyCSS; //Layouter.WriteLayoutTree; end; Renderer.Draw(Self); fDrawing:=false; end; function TTestViewport.IsDrawing: boolean; begin Result:=fDrawing; end; { TCustomTestFresnelCSS } procedure TCustomTestFresnelCSS.SetUp; begin inherited SetUp; Viewport:=TTestViewport.Create(nil); end; procedure TCustomTestFresnelCSS.TearDown; begin FreeAndNil(Viewport); inherited TearDown; end; { TTestFresnelCSS } procedure TTestFresnelCSS.TestEmptyViewport; begin Viewport.ApplyCSS; end; procedure TTestFresnelCSS.TestBody; var Body: TBody; begin writeln('TTestFresnelCSS.TestBody START'); Body:=TBody.Create(Viewport); Body.Name:='Body'; Body.Parent:=Viewport; Viewport.ApplyCSS; //Body.WriteComputedAttributes('Body'); writeln('TTestFresnelCSS.TestBody END'); end; procedure TTestFresnelCSS.TestGetStyleAttr_OneValue; begin if Viewport.Style<>'' then Fail('20240820190117'); Viewport.Style:='padding:3px'; AssertEquals('padding:3px',Viewport.Style); AssertEquals('3px',Viewport.GetStyleAttr('padding')); end; procedure TTestFresnelCSS.TestGetStyleAttr_TwoValues; begin Viewport.Style:='padding-left:3px; padding-top: 4px'; AssertEquals('3px',Viewport.GetStyleAttr('padding-left')); AssertEquals('4px',Viewport.GetStyleAttr('padding-top')); end; procedure TTestFresnelCSS.TestGetStyleAttr_OneFunction; begin Viewport.Style:='padding-left:var(--bird)'; AssertEquals('var(--bird)',Viewport.GetStyleAttr('padding-left')); end; procedure TTestFresnelCSS.TestGetStyleAttr_TwoFunctions; begin Viewport.Style:='padding-left:var(--bird); padding-right: min(10px, 20%) '; AssertEquals('var(--bird)',Viewport.GetStyleAttr('padding-left')); AssertEquals('min(10px, 20%)',Viewport.GetStyleAttr('padding-right')); end; procedure TTestFresnelCSS.TestGetStyleAttr_NestedFunctions; begin Viewport.Style:='padding-left: calc(var(--bird)*10%) ; padding-right: min(max(10%,3em), 20%) min(3px,5ch)'; AssertEquals('calc(var(--bird)*10%)',Viewport.GetStyleAttr('padding-left')); AssertEquals('min(max(10%,3em), 20%) min(3px,5ch)',Viewport.GetStyleAttr('padding-right')); end; procedure TTestFresnelCSS.TestSetStyleAttr_NewValueEmpty; begin if not Viewport.SetStyleAttr('padding-left','') then Fail('20240820193346'); AssertEquals('',Viewport.Style); end; procedure TTestFresnelCSS.TestSetStyleAttr_NewValueFirst; begin if not Viewport.SetStyleAttr('padding-left','3px') then Fail('20240820193354'); AssertEquals('padding-left:3px',Viewport.Style); end; procedure TTestFresnelCSS.TestSetStyleAttr_NewValueAppend; begin Viewport.Style:='padding-left:4px'; if not Viewport.SetStyleAttr('padding-right','7px') then Fail('20240820193401'); AssertEquals('padding-left:4px; padding-right:7px',Viewport.Style); end; procedure TTestFresnelCSS.TestSetStyleAttr_NewValueAppendSemicolon; begin Viewport.Style:='padding-left:4px ;'; if not Viewport.SetStyleAttr('padding-right','7px') then Fail('20240820194710'); AssertEquals('padding-left:4px ; padding-right:7px',Viewport.Style); end; procedure TTestFresnelCSS.TestSetStyleAttr_DeleteOnlyValue; begin Viewport.Style:='padding-left:4px'; if not Viewport.SetStyleAttr('padding-left','') then Fail('20240820193844'); AssertEquals('',Viewport.Style); end; procedure TTestFresnelCSS.TestSetStyleAttr_DeleteFirstValue; begin Viewport.Style:='padding-left:4px; padding-top:3px'; if not Viewport.SetStyleAttr('padding-left','') then Fail('20240820193847'); AssertEquals('padding-top:3px',Viewport.Style); end; procedure TTestFresnelCSS.TestSetStyleAttr_DeleteLastValue; begin Viewport.Style:='padding-left:4px ; padding-top:3px'; if not Viewport.SetStyleAttr('padding-top','') then Fail('20240820194509'); AssertEquals('padding-left:4px ;',Viewport.Style); end; procedure TTestFresnelCSS.TestSetStyleAttr_DeleteMiddleValue; begin Viewport.Style:='padding-left:4px ; padding-top:3px; padding-right: 2px'; if not Viewport.SetStyleAttr('padding-top','') then Fail('20240820195100'); AssertEquals('padding-left:4px ;padding-right: 2px',Viewport.Style); end; procedure TTestFresnelCSS.TestSetStyleAttr_ReplaceOnlyValue; begin Viewport.Style:='padding-left: 4px;'; if not Viewport.SetStyleAttr('padding-left','5em') then Fail('20240820195245'); AssertEquals('padding-left:5em;',Viewport.Style); end; procedure TTestFresnelCSS.TestSetStyleAttr_ReplaceFirstValue; begin Viewport.Style:='padding-left: 4px ; padding-top:3px'; if not Viewport.SetStyleAttr('padding-left','7em') then Fail('20240820195924'); AssertEquals('padding-left:7em; padding-top:3px',Viewport.Style); end; procedure TTestFresnelCSS.TestSetStyleAttr_ReplaceLastValue; begin Viewport.Style:='padding-left: 4px ; padding-top: 3px '; if not Viewport.SetStyleAttr('padding-top','7em') then Fail('20240820200021'); AssertEquals('padding-left: 4px ; padding-top:7em',Viewport.Style); end; procedure TTestFresnelCSS.TestSetStyleAttr_ReplaceMiddleValue; begin Viewport.Style:='padding-left:4px ; padding-top: 3px ; padding-right: 2px'; if not Viewport.SetStyleAttr('padding-top','7em') then Fail('20240820200135'); AssertEquals('padding-left:4px ; padding-top:7em; padding-right: 2px',Viewport.Style); end; procedure TTestFresnelCSS.Test_FontSize_Percentage; var Body: TBody; Div1: TDiv; begin Viewport.Stylesheet.Text:=LinesToStr([ 'body {', 'font-size:30px;', '}', 'div {', 'font-size:200%;', '}']); Body:=TBody.Create(Viewport); Body.Name:='Body'; Body.Parent:=Viewport; Div1:=TDiv.Create(Viewport); Div1.Name:='Div1'; Div1.Parent:=Body; Viewport.ApplyCSS; AssertEquals('Body.Font.GetSize',Body.Font.GetSize,30); AssertEquals('Div1.Font.GetSize',Div1.Font.GetSize,60); end; procedure TTestFresnelCSS.Test_FontSize_AsString; var Body: TBody; begin Viewport.Stylesheet.Text:=LinesToStr([ 'body {', 'font-size:3em;', '}']); Body:=TBody.Create(Viewport); Body.Name:='Body'; Body.Parent:=Viewport; Viewport.ApplyCSS; AssertEquals('Body.Font.GetSize',30,Body.Font.GetSize); AssertEquals('Body.GetComputedString(fcaFontSize)','30px',Body.GetComputedString(fcaFontSize)); end; procedure TTestFresnelCSS.Test_Font_AsString; var Body: TBody; begin Viewport.Stylesheet.Text:=LinesToStr([ 'body {', 'font-family:Arial;', 'font-kerning:normal;', 'font-size:12px;', 'font-style:italic;', 'font-weight:250;', 'font-width:condensed;', 'line-height:20px;', '}']); Body:=TBody.Create(Viewport); Body.Name:='Body'; Body.Parent:=Viewport; Viewport.ApplyCSS; AssertEquals('Body.Font.GetFamily','Arial',Body.Font.GetFamily); AssertEquals('Body.GetComputedString(fcaFontFamily)','Arial',Body.GetComputedString(fcaFontFamily)); AssertEquals('Body.Font.GetKerning','normal',FresnelCSSKerningNames[Body.Font.GetKerning]); AssertEquals('Body.GetComputedString(fcaFontKerning)','normal',Body.GetComputedString(fcaFontKerning)); AssertEquals('Body.Font.GetSize',12,Body.Font.GetSize); AssertEquals('Body.GetComputedString(fcaFontSize)','12px',Body.GetComputedString(fcaFontSize)); AssertEquals('Body.Font.GetStyle','italic',Body.Font.GetStyle); AssertEquals('Body.GetComputedString(fcaFontStyle)','italic',Body.GetComputedString(fcaFontStyle)); AssertEquals('Body.Font.GetWeight',250,Body.Font.GetWeight); AssertEquals('Body.GetComputedString(fcaFontWeight)','250',Body.GetComputedString(fcaFontWeight)); AssertEquals('Body.Font.GetWidth',0.75,Body.Font.GetWidth); AssertEquals('Body.GetComputedString(fcaFontWidth)','75%',Body.GetComputedString(fcaFontWidth)); AssertEquals('Body.GetComputedString(fcaFontStretch)','75%',Body.GetComputedString(fcaFontStretch)); AssertEquals('Body.GetComputedString(fcaFont)','italic 250 12px/20px condensed Arial',Body.GetComputedString(fcaFont)); end; procedure TTestFresnelCSS.Test_Overflow_AsString; var Body: TBody; begin Viewport.Stylesheet.Text:=LinesToStr([ 'body {', 'overflow:visible hidden;', '}']); Body:=TBody.Create(Viewport); Body.Name:='Body'; Body.Parent:=Viewport; Viewport.ApplyCSS; AssertEquals('Body.GetComputedString(fcaOverflowX)','visible',Body.GetComputedString(fcaOverflowX)); AssertEquals('Body.GetComputedString(fcaOverflowY)','hidden',Body.GetComputedString(fcaOverflowY)); AssertEquals('Body.GetComputedString(fcaOverflow)','auto hidden',Body.GetComputedString(fcaOverflow)); end; procedure TTestFresnelCSS.Test_BorderColor_AsString; var Div1: TDiv; begin Viewport.Stylesheet.Text:=LinesToStr([ 'div {', 'border-color:#111 #222 #333 #444;', '}']); Div1:=TDiv.Create(Viewport); Div1.Name:='Div1'; Div1.Parent:=Viewport; Viewport.ApplyCSS; AssertEquals('Div1.GetComputedString(fcaBorderTopColor)','#111',Div1.GetComputedString(fcaBorderTopColor)); AssertEquals('Div1.GetComputedString(fcaBorderRightColor)','#222',Div1.GetComputedString(fcaBorderRightColor)); AssertEquals('Div1.GetComputedString(fcaBorderBottomColor)','#333',Div1.GetComputedString(fcaBorderBottomColor)); AssertEquals('Div1.GetComputedString(fcaBorderLeftColor)','#444',Div1.GetComputedString(fcaBorderLeftColor)); AssertEquals('Div1.GetComputedString(fcaBorderColor)','#111 #222 #333 #444',Div1.GetComputedString(fcaBorderColor)); end; procedure TTestFresnelCSS.Test_BorderStyle_AsString; var Div1: TDiv; begin Viewport.Stylesheet.Text:=LinesToStr([ 'div {', 'border-style:solid dashed ridge none;', '}']); Div1:=TDiv.Create(Viewport); Div1.Name:='Div1'; Div1.Parent:=Viewport; Viewport.ApplyCSS; AssertEquals('Div1.GetComputedString(fcaBorderTopStyle)','solid',Div1.GetComputedString(fcaBorderTopStyle)); AssertEquals('Div1.GetComputedString(fcaBorderRightStyle)','dashed',Div1.GetComputedString(fcaBorderRightStyle)); AssertEquals('Div1.GetComputedString(fcaBorderBottomStyle)','ridge',Div1.GetComputedString(fcaBorderBottomStyle)); AssertEquals('Div1.GetComputedString(fcaBorderLeftStyle)','none',Div1.GetComputedString(fcaBorderLeftStyle)); AssertEquals('Div1.GetComputedString(fcaBorderStyle)','solid dashed ridge none',Div1.GetComputedString(fcaBorderStyle)); end; procedure TTestFresnelCSS.Test_BorderWidth_AsString; var Div1: TDiv; begin Viewport.Stylesheet.Text:=LinesToStr([ 'div {', 'border-width:1px 2px 3px 4px;', '}']); Div1:=TDiv.Create(Viewport); Div1.Name:='Div1'; Div1.Parent:=Viewport; Viewport.ApplyCSS; AssertEquals('Div1.GetComputedString(fcaBorderTopWidth)','1px',Div1.GetComputedString(fcaBorderTopWidth)); AssertEquals('Div1.GetComputedString(fcaBorderRightWidth)','2px',Div1.GetComputedString(fcaBorderRightWidth)); AssertEquals('Div1.GetComputedString(fcaBorderBottomWidth)','3px',Div1.GetComputedString(fcaBorderBottomWidth)); AssertEquals('Div1.GetComputedString(fcaBorderLeftWidth)','4px',Div1.GetComputedString(fcaBorderLeftWidth)); AssertEquals('Div1.GetComputedString(fcaBorderWidth)','1px 2px 3px 4px',Div1.GetComputedString(fcaBorderWidth)); end; procedure TTestFresnelCSS.Test_Border_AsString; var Div1: TDiv; begin Viewport.Stylesheet.Text:=LinesToStr([ 'div {', 'border:1px red solid;', '}']); Div1:=TDiv.Create(Viewport); Div1.Name:='Div1'; Div1.Parent:=Viewport; Viewport.ApplyCSS; AssertEquals('Div1.GetComputedString(fcaBorderTopWidth)','1px',Div1.GetComputedString(fcaBorderTopWidth)); AssertEquals('Div1.GetComputedString(fcaBorderRightWidth)','1px',Div1.GetComputedString(fcaBorderRightWidth)); AssertEquals('Div1.GetComputedString(fcaBorderBottomWidth)','1px',Div1.GetComputedString(fcaBorderBottomWidth)); AssertEquals('Div1.GetComputedString(fcaBorderLeftWidth)','1px',Div1.GetComputedString(fcaBorderLeftWidth)); AssertEquals('Div1.GetComputedString(fcaBorderTopStyle)','solid',Div1.GetComputedString(fcaBorderTopStyle)); AssertEquals('Div1.GetComputedString(fcaBorderRightStyle)','solid',Div1.GetComputedString(fcaBorderRightStyle)); AssertEquals('Div1.GetComputedString(fcaBorderBottomStyle)','solid',Div1.GetComputedString(fcaBorderBottomStyle)); AssertEquals('Div1.GetComputedString(fcaBorderLeftStyle)','solid',Div1.GetComputedString(fcaBorderLeftStyle)); AssertEquals('Div1.GetComputedString(fcaBorderTopColor)','red',Div1.GetComputedString(fcaBorderTopColor)); AssertEquals('Div1.GetComputedString(fcaBorderRightColor)','red',Div1.GetComputedString(fcaBorderRightColor)); AssertEquals('Div1.GetComputedString(fcaBorderBottomColor)','red',Div1.GetComputedString(fcaBorderBottomColor)); AssertEquals('Div1.GetComputedString(fcaBorderLeftColor)','red',Div1.GetComputedString(fcaBorderLeftColor)); AssertEquals('Div1.GetComputedString(fcaBorderTop)','red solid 1px',Div1.GetComputedString(fcaBorderTop)); AssertEquals('Div1.GetComputedString(fcaBorderRight)','red solid 1px',Div1.GetComputedString(fcaBorderRight)); AssertEquals('Div1.GetComputedString(fcaBorderBottom)','red solid 1px',Div1.GetComputedString(fcaBorderBottom)); AssertEquals('Div1.GetComputedString(fcaBorderLeft)','red solid 1px',Div1.GetComputedString(fcaBorderLeft)); AssertEquals('Div1.GetComputedString(fcaBorderWidth)','red solid 1px',Div1.GetComputedString(fcaBorder)); end; procedure TTestFresnelCSS.Test_BorderRadius_AsString; var Div1: TDiv; p: TFresnelPoint; begin Viewport.Stylesheet.Text:=LinesToStr([ 'div {', 'border-radius:1px 2px 3px 4px / 5px 6px 7px 8px;', '}']); Div1:=TDiv.Create(Viewport); Div1.Name:='Div1'; Div1.Parent:=Viewport; Viewport.ApplyCSS; AssertEquals('Div1.GetComputedString(fcaBorderTopLeftRadius)','1px / 5px',Div1.GetComputedString(fcaBorderTopLeftRadius)); AssertEquals('Div1.GetComputedString(fcaBorderTopRightRadius)','2px / 6px',Div1.GetComputedString(fcaBorderTopRightRadius)); AssertEquals('Div1.GetComputedString(fcaBorderBottomRightRadius)','3px / 7px',Div1.GetComputedString(fcaBorderBottomRightRadius)); AssertEquals('Div1.GetComputedString(fcaBorderBottomLeftRadius)','4px / 8px',Div1.GetComputedString(fcaBorderBottomLeftRadius)); p:=Div1.GetComputedBorderRadius(fcsTopLeft); AssertEquals('Div1.GetComputedBorderRadius(fcsTopLeft)','(1,5)',p.ToString); AssertEquals('Div1.GetComputedString(fcaBorderRadius)','1px 2px 3px 4px / 5px 6px 7px 8px',Div1.GetComputedString(fcaBorderRadius)); end; procedure TTestFresnelCSS.Test_Margin_AsString; var Div1: TDiv; begin Viewport.Stylesheet.Text:=LinesToStr([ 'div {', 'margin:1px 2px 3px 4px;', '}']); Div1:=TDiv.Create(Viewport); Div1.Name:='Div1'; Div1.Parent:=Viewport; Viewport.ApplyCSS; AssertEquals('Div1.GetComputedString(fcaMarginTop)','1px',Div1.GetComputedString(fcaMarginTop)); AssertEquals('Div1.GetComputedString(fcaMarginRight)','2px',Div1.GetComputedString(fcaMarginRight)); AssertEquals('Div1.GetComputedString(fcaMarginBottom)','3px',Div1.GetComputedString(fcaMarginBottom)); AssertEquals('Div1.GetComputedString(fcaMarginLeft)','4px',Div1.GetComputedString(fcaMarginLeft)); AssertEquals('Div1.GetComputedString(fcaMargin)','1px 2px 3px 4px',Div1.GetComputedString(fcaMargin)); end; procedure TTestFresnelCSS.Test_MarginBlock_AsString; var Div1: TDiv; begin exit; Viewport.Stylesheet.Text:=LinesToStr([ 'div {', 'margin-block:1px 2px;', '}']); Div1:=TDiv.Create(Viewport); Div1.Name:='Div1'; Div1.Parent:=Viewport; Viewport.ApplyCSS; AssertEquals('Div1.GetComputedString(fcaMarginBlockStart)','1px',Div1.GetComputedString(fcaMarginBlockStart)); AssertEquals('Div1.GetComputedString(fcaMarginBlockEnd)','2px',Div1.GetComputedString(fcaMarginBlockEnd)); AssertEquals('Div1.GetComputedString(fcaMarginTop)','3px',Div1.GetComputedString(fcaMarginTop)); AssertEquals('Div1.GetComputedString(fcaMarginRight)','4px',Div1.GetComputedString(fcaMarginRight)); AssertEquals('Div1.GetComputedString(fcaMarginBottom)','3px',Div1.GetComputedString(fcaMarginBottom)); AssertEquals('Div1.GetComputedString(fcaMarginLeft)','4px',Div1.GetComputedString(fcaMarginLeft)); AssertEquals('Div1.GetComputedString(fcaMarginWidth)','1px 2px 3px 4px',Div1.GetComputedString(fcaMargin)); end; procedure TTestFresnelCSS.Test_Padding_AsString; var Div1: TDiv; begin Viewport.Stylesheet.Text:=LinesToStr([ 'div {', 'padding:1px 2px 3px 4px;', '}']); Div1:=TDiv.Create(Viewport); Div1.Name:='Div1'; Div1.Parent:=Viewport; Viewport.ApplyCSS; AssertEquals('Div1.GetComputedString(fcaPaddingTop)','1px',Div1.GetComputedString(fcaPaddingTop)); AssertEquals('Div1.GetComputedString(fcaPaddingRight)','2px',Div1.GetComputedString(fcaPaddingRight)); AssertEquals('Div1.GetComputedString(fcaPaddingBottom)','3px',Div1.GetComputedString(fcaPaddingBottom)); AssertEquals('Div1.GetComputedString(fcaPaddingLeft)','4px',Div1.GetComputedString(fcaPaddingLeft)); AssertEquals('Div1.GetComputedString(fcaPadding)','1px 2px 3px 4px',Div1.GetComputedString(fcaPadding)); end; procedure TTestFresnelCSS.Test_BackgroundPosition_AsString; var Div1: TDiv; begin Viewport.Stylesheet.Text:=LinesToStr([ 'div {', 'background-position:left 10px bottom 15%;', '}']); Div1:=TDiv.Create(Viewport); Div1.Name:='Div1'; Div1.Parent:=Viewport; Viewport.ApplyCSS; AssertEquals('Div1.GetComputedString(fcaBackgroundPositionX)','left 10px',Div1.GetComputedString(fcaBackgroundPositionX)); AssertEquals('Div1.GetComputedString(fcaBackgroundPositionY)','bottom 15%',Div1.GetComputedString(fcaBackgroundPositionY)); AssertEquals('Div1.GetComputedString(fcaBackgroundPosition)','left 10px bottom 15%',Div1.GetComputedString(fcaBackgroundPosition)); end; procedure TTestFresnelCSS.TestVar_NoDefault; var Body: TBody; begin Viewport.Stylesheet.Text:=LinesToStr([ ':root {', '--bird-color:red;', '}', 'body {', 'color:var(--bird-color);', '}']); Body:=TBody.Create(Viewport); Body.Name:='Body'; Body.Parent:=Viewport; Viewport.ApplyCSS; AssertEquals('red',Viewport.GetComputedCSSString('--bird-color')); AssertEquals('red',Body.GetComputedCSSString('--bird-color')); AssertEquals('red',Body.GetComputedCSSString('color')); end; procedure TTestFresnelCSS.TestVar_Initial; var Body: TBody; Div1: TDiv; begin Viewport.Stylesheet.Text:=LinesToStr([ 'body {', 'font-size:30px;', '}', 'div {', 'font-size:var(--none,initial);', '}']); Body:=TBody.Create(Viewport); Body.Name:='Body'; Body.Parent:=Viewport; Div1:=TDiv.Create(Viewport); Div1.Name:='Div1'; Div1.Parent:=Body; Viewport.ApplyCSS; AssertEquals('Body.GetComputedFontSize',Body.Font.GetSize,30); AssertEquals('Div1.GetComputedFontSize',Div1.Font.GetSize,FresnelDefaultFontSize); end; procedure TTestFresnelCSS.TestVar_Inline; var Div1: TDiv; begin Viewport.Stylesheet.Text:=LinesToStr([ 'div {', 'font-size:var(--size);', '}']); Div1:=TDiv.Create(Viewport); Div1.Name:='Div1'; Div1.Parent:=Viewport; Div1.Style:='--size:28px;'; Viewport.ApplyCSS; AssertEquals('Div1.GetComputedFontSize',28,Div1.Font.GetSize); end; Initialization RegisterTests([TTestFresnelCSS]); end.