Browse Source

added TCursorTimer.Redraw, TFresnelElement.Invalidate, InvalidateIfNotDrawing, ComputeCSSLayoutFinished

mattias 5 months ago
parent
commit
641fa4aa2e
4 changed files with 105 additions and 27 deletions
  1. 30 10
      src/base/fresnel.cursortimer.pp
  2. 40 0
      src/base/fresnel.dom.pas
  3. 12 7
      src/base/fresnel.edit.pp
  4. 23 10
      src/base/fresnel.forms.pas

+ 30 - 10
src/base/fresnel.cursortimer.pp

@@ -18,23 +18,26 @@ type
   TCursorTimer = class
   TCursorTimer = class
   private
   private
     FBlinkControl: IBlinkControl;
     FBlinkControl: IBlinkControl;
-    FBlink : Boolean;
+    FVisible: Boolean;
     FBlinkRate: Word;
     FBlinkRate: Word;
     FTimer : TFPTimer;
     FTimer : TFPTimer;
     class var _Instance: TCursorTimer;
     class var _Instance: TCursorTimer;
+    function GetVisible: boolean;
     procedure HandleBlink(Sender: TObject);
     procedure HandleBlink(Sender: TObject);
     procedure SetBlinkControl(const aValue: IBlinkControl);
     procedure SetBlinkControl(const aValue: IBlinkControl);
     procedure SetBlinkRate(const aValue: Word);
     procedure SetBlinkRate(const aValue: Word);
   protected
   protected
     procedure DisableTimer;
     procedure DisableTimer;
     procedure EnableTimer;
     procedure EnableTimer;
-    Procedure Blink;
+    Procedure Blink; virtual;
   Public
   Public
     class constructor Init;
     class constructor Init;
     class destructor Done;
     class destructor Done;
-    constructor create; virtual;
+    constructor Create; virtual;
+    procedure Restart; virtual; // if blinking, restart timer and show cursor
     Property BlinkControl : IBlinkControl Read FBlinkControl Write SetBlinkControl;
     Property BlinkControl : IBlinkControl Read FBlinkControl Write SetBlinkControl;
-    Property BlinkRate : Word Read FBlinkRate Write SetBlinkRate;
+    Property BlinkRate : Word Read FBlinkRate Write SetBlinkRate; // interval in ms
+    Property Visible : boolean read GetVisible;
     Class property Instance : TCursorTimer Read _Instance;
     Class property Instance : TCursorTimer Read _Instance;
   end;
   end;
 
 
@@ -52,8 +55,8 @@ end;
 procedure TCursorTimer.SetBlinkControl(const aValue: IBlinkControl);
 procedure TCursorTimer.SetBlinkControl(const aValue: IBlinkControl);
 begin
 begin
   if FBlinkControl=aValue then Exit;
   if FBlinkControl=aValue then Exit;
-  FBlink:=False;
-  Blink;
+  if FVisible then
+    Blink; // hide old cursor
   DisableTimer;
   DisableTimer;
   FBlinkControl:=aValue;
   FBlinkControl:=aValue;
   if assigned(FBlinkControl) then
   if assigned(FBlinkControl) then
@@ -65,6 +68,11 @@ begin
   Blink;
   Blink;
 end;
 end;
 
 
+function TCursorTimer.GetVisible: boolean;
+begin
+  Result:=(BlinkControl<>nil) and FVisible;
+end;
+
 procedure TCursorTimer.SetBlinkRate(const aValue: Word);
 procedure TCursorTimer.SetBlinkRate(const aValue: Word);
 begin
 begin
   if FBlinkRate=aValue then Exit;
   if FBlinkRate=aValue then Exit;
@@ -79,7 +87,7 @@ end;
 procedure TCursorTimer.DisableTimer;
 procedure TCursorTimer.DisableTimer;
 begin
 begin
   if assigned(FTimer) then
   if assigned(FTimer) then
-    FTimer.Enabled:=False
+    FTimer.Enabled:=False;
 end;
 end;
 
 
 procedure TCursorTimer.EnableTimer;
 procedure TCursorTimer.EnableTimer;
@@ -95,9 +103,9 @@ end;
 
 
 procedure TCursorTimer.Blink;
 procedure TCursorTimer.Blink;
 begin
 begin
+  FVisible:=Not FVisible;
   if Assigned(FBlinkControl) then
   if Assigned(FBlinkControl) then
-    FBlinkControl.Blink(FBlink);
-  FBlink:=Not FBlink;
+    FBlinkControl.Blink(FVisible);
 end;
 end;
 
 
 class constructor TCursorTimer.Init;
 class constructor TCursorTimer.Init;
@@ -110,10 +118,22 @@ begin
   FreeAndNil(_instance);
   FreeAndNil(_instance);
 end;
 end;
 
 
-constructor TCursorTimer.create;
+constructor TCursorTimer.Create;
 begin
 begin
   FBlinkRate:=500;
   FBlinkRate:=500;
 end;
 end;
 
 
+procedure TCursorTimer.Restart;
+begin
+  if FTimer=nil then exit;
+  if FTimer.Enabled then
+    begin
+    FTimer.Enabled:=false;
+    FTimer.Enabled:=true;
+    end;
+  if not FVisible then
+    Blink;
+end;
+
 end.
 end.
 
 

+ 40 - 0
src/base/fresnel.dom.pas

@@ -1117,6 +1117,7 @@ type
     function GetRoot: TFresnelElement;
     function GetRoot: TFresnelElement;
     function GetPath: string; virtual;
     function GetPath: string; virtual;
     function AcceptChildrenAtDesignTime: boolean; virtual;
     function AcceptChildrenAtDesignTime: boolean; virtual;
+
     // Can this widget handle focus ?
     // Can this widget handle focus ?
     class function HandleFocus : Boolean; virtual;
     class function HandleFocus : Boolean; virtual;
     // Can this widget focus now ?
     // Can this widget focus now ?
@@ -1125,7 +1126,10 @@ type
     function IsFocused : Boolean;
     function IsFocused : Boolean;
     // Attempt to set focus to this element. Return true if we got focus.
     // Attempt to set focus to this element. Return true if we got focus.
     function Focus : Boolean;
     function Focus : Boolean;
+
     procedure DomChanged; virtual;
     procedure DomChanged; virtual;
+    procedure Invalidate; virtual; // queue a redraw
+    procedure InvalidateIfNotDrawing;
     property Parent: TFresnelElement read FParent write SetParent;
     property Parent: TFresnelElement read FParent write SetParent;
     property NodeCount: integer read GetNodeCount;
     property NodeCount: integer read GetNodeCount;
     property Nodes[Index: integer]: TFresnelElement read GetNodes; default;
     property Nodes[Index: integer]: TFresnelElement read GetNodes; default;
@@ -1179,6 +1183,7 @@ type
     procedure ComputeInlineStyle; virtual; // parse inline style
     procedure ComputeInlineStyle; virtual; // parse inline style
     procedure ComputeCSSValues; virtual; // call resolver to collect CSS values and resolve shorthands
     procedure ComputeCSSValues; virtual; // call resolver to collect CSS values and resolve shorthands
     procedure ComputeCSSAfterLayoutNode(Layouter: TFresnelLayouter); virtual; // called after layouter node, before layouter traverse children
     procedure ComputeCSSAfterLayoutNode(Layouter: TFresnelLayouter); virtual; // called after layouter node, before layouter traverse children
+    procedure ComputeCSSLayoutFinished; virtual; // called after layout was finished
     function GetCSSString(AttrID: TCSSNumericalID; Compute: boolean; out Complete: boolean): string; virtual;
     function GetCSSString(AttrID: TCSSNumericalID; Compute: boolean; out Complete: boolean): string; virtual;
     function GetComputedLength(Attr: TFresnelCSSAttribute; UseNaNOnFail: boolean = false; NoChildren: boolean = false): TFresnelLength; virtual; overload;
     function GetComputedLength(Attr: TFresnelCSSAttribute; UseNaNOnFail: boolean = false; NoChildren: boolean = false): TFresnelLength; virtual; overload;
     function GetComputedLength(AttrID: TCSSNumericalID; UseNaNOnFail: boolean = false; NoChildren: boolean = false): TFresnelLength; virtual; overload;
     function GetComputedLength(AttrID: TCSSNumericalID; UseNaNOnFail: boolean = false; NoChildren: boolean = false): TFresnelLength; virtual; overload;
@@ -1430,6 +1435,7 @@ type
     procedure DomChanged; override;
     procedure DomChanged; override;
     procedure Disconnecting; virtual;
     procedure Disconnecting; virtual;
     function AllocateFont(const Desc: TFresnelFontDesc): IFresnelFont; virtual;
     function AllocateFont(const Desc: TFresnelFontDesc): IFresnelFont; virtual;
+    function IsDrawing: boolean; virtual; abstract;
     function GetCSSString(AttrID: TCSSNumericalID; Compute: boolean; out Complete: boolean): string; override;
     function GetCSSString(AttrID: TCSSNumericalID; Compute: boolean; out Complete: boolean): string; override;
     class function CSSTypeID: TCSSNumericalID; override;
     class function CSSTypeID: TCSSNumericalID; override;
     class function CSSTypeName: TCSSString; override;
     class function CSSTypeName: TCSSString; override;
@@ -5796,6 +5802,19 @@ procedure TFresnelViewport.ApplyCSS;
       TraverseCSS(El.PseudoNodes[i]);
       TraverseCSS(El.PseudoNodes[i]);
   end;
   end;
 
 
+  procedure TraverseLayoutFinished(El: TFresnelElement);
+  var
+    i: Integer;
+  begin
+    El.ComputeCSSLayoutFinished;
+    if fesPseudoElement in FStates then
+      exit;
+    for i:=0 to El.NodeCount-1 do
+      TraverseLayoutFinished(El.Nodes[i]);
+    for i:=0 to El.PseudoNodeCount-1 do
+      TraverseLayoutFinished(El.PseudoNodes[i]);
+  end;
+
 begin
 begin
   //writeln('TFresnelViewport.ApplyCSS ',Name,' Width=',FloatToCSSStr(Width),',Height=',FloatToCSSStr(Height));
   //writeln('TFresnelViewport.ApplyCSS ',Name,' Width=',FloatToCSSStr(Width),',Height=',FloatToCSSStr(Height));
   DomModified:=false;
   DomModified:=false;
@@ -5808,6 +5827,8 @@ begin
   TraverseCSS(Self);
   TraverseCSS(Self);
   // layout
   // layout
   Layouter.Apply;
   Layouter.Apply;
+  // notify layout finished
+  TraverseLayoutFinished(Self);
 end;
 end;
 
 
 procedure TFresnelViewport.DomChanged;
 procedure TFresnelViewport.DomChanged;
@@ -7865,6 +7886,20 @@ begin
     FParent.DomChanged;
     FParent.DomChanged;
 end;
 end;
 
 
+procedure TFresnelElement.Invalidate;
+begin
+  if LayoutNode=nil then exit;
+  if LayoutNode.SkipRendering then exit;
+  if (Viewport<>nil) and (Viewport<>Self) then
+    Viewport.Invalidate;
+end;
+
+procedure TFresnelElement.InvalidateIfNotDrawing;
+begin
+  if (Viewport<>nil) and not Viewport.IsDrawing then
+    Invalidate;
+end;
+
 function TFresnelElement.HasParent: Boolean;
 function TFresnelElement.HasParent: Boolean;
 begin
 begin
   Result:=Parent<>nil;
   Result:=Parent<>nil;
@@ -8497,6 +8532,11 @@ begin
   if Layouter<>nil then ;
   if Layouter<>nil then ;
 end;
 end;
 
 
+procedure TFresnelElement.ComputeCSSLayoutFinished;
+begin
+
+end;
+
 { TPseudoElement }
 { TPseudoElement }
 
 
 constructor TPseudoElement.Create(AOwner: TComponent);
 constructor TPseudoElement.Create(AOwner: TComponent);

+ 12 - 7
src/base/fresnel.edit.pp

@@ -1,4 +1,4 @@
-unit fresnel.edit;
+unit Fresnel.Edit;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 
@@ -6,7 +6,7 @@ interface
 
 
 uses
 uses
   Classes, fpImage, fpCSSResParser, fpCSSTree, fresnel.CursorTimer,
   Classes, fpImage, fpCSSResParser, fpCSSTree, fresnel.CursorTimer,
-  Fresnel.TextLayouter, Fresnel.Classes, Fresnel.Dom, Fresnel.Keys, Fresnel.Controls,
+  Fresnel.Classes, Fresnel.Dom, Fresnel.Keys, Fresnel.Controls,
   FCL.events, Fresnel.Events, Utf8Utils;
   FCL.events, Fresnel.Events, Utf8Utils;
 
 
 
 
@@ -365,6 +365,7 @@ procedure TEdit.HandleMouseUp(aEvent: TFresnelMouseEvent);
 begin
 begin
   // Nothing for the moment;
   // Nothing for the moment;
   // When popup menus are handled, then here we should show the popup if it was the right button.
   // When popup menus are handled, then here we should show the popup if it was the right button.
+  if aEvent=nil then ;
 end;
 end;
 
 
 procedure TEdit.HandleMouseDown(aEvent: TFresnelMouseEvent);
 procedure TEdit.HandleMouseDown(aEvent: TFresnelMouseEvent);
@@ -431,7 +432,7 @@ end;
 procedure TEdit.Blink(aVisible: Boolean);
 procedure TEdit.Blink(aVisible: Boolean);
 begin
 begin
   FCursorVisible:=IsFocused and aVisible;
   FCursorVisible:=IsFocused and aVisible;
-  DomChanged;
+  InvalidateIfNotDrawing;
 end;
 end;
 
 
 class function TEdit.IsSpecialChar(aUnicodeChar : string) : boolean;
 class function TEdit.IsSpecialChar(aUnicodeChar : string) : boolean;
@@ -498,6 +499,7 @@ begin
   lPos  := 1;
   lPos  := 1;
   lCharNum := 0;
   lCharNum := 0;
   FDrawOffset := 0;
   FDrawOffset := 0;
+  lCharX := 0;
   while lPos <= Length(ltext) do
   while lPos <= Length(ltext) do
   begin
   begin
     lPrevPos := lPos;
     lPrevPos := lPos;
@@ -639,7 +641,7 @@ var
   lLeftSideMargin,
   lLeftSideMargin,
   lRightSideMargin,
   lRightSideMargin,
   lMaxWidth,
   lMaxWidth,
-  lCursorX: TFresnelLength;
+  lCursorX, NewCursorX: TFresnelLength;
   r: TFresnelRect;
   r: TFresnelRect;
 
 
 begin
 begin
@@ -657,7 +659,12 @@ begin
     if lCursorX <> 0 then
     if lCursorX <> 0 then
       FTextOffset:=FTextOffset-CursorWidth;
       FTextOffset:=FTextOffset-CursorWidth;
     end;
     end;
-  FCursorX := lCursorX - FTextOffset + lLeftSideMargin;
+  NewCursorX := lCursorX - FTextOffset + lLeftSideMargin;
+  if NewCursorX<>FCursorX then
+    begin
+    FCursorX := lCursorX - FTextOffset + lLeftSideMargin;
+    CursorTimer.Restart;
+    end;
 end;
 end;
 
 
 procedure TEdit.SetPlaceHolder(const aValue: TFresnelCaption);
 procedure TEdit.SetPlaceHolder(const aValue: TFresnelCaption);
@@ -780,14 +787,12 @@ var
   var
   var
     lCur : TFresnelRect;
     lCur : TFresnelRect;
   begin
   begin
-    if not FCursorVisible then exit;
     lCur:=RenderedContentBox;
     lCur:=RenderedContentBox;
     lCur.Left:=lCur.Left+FCursorX; // CursorX has leftmargin
     lCur.Left:=lCur.Left+FCursorX; // CursorX has leftmargin
     lCur.Right:=lCur.Left+CursorWidth;
     lCur.Right:=lCur.Left+CursorWidth;
     aRenderer.FillRect(colBlack,lCur);
     aRenderer.FillRect(colBlack,lCur);
   end;
   end;
 
 
-
 begin
 begin
   // These will calculate FVisibleText etc.
   // These will calculate FVisibleText etc.
   MaybeRecalcParams;
   MaybeRecalcParams;

+ 23 - 10
src/base/fresnel.forms.pas

@@ -34,7 +34,8 @@ type
   TFormState = (
   TFormState = (
     fsMinimized,
     fsMinimized,
     fsMaximized,
     fsMaximized,
-    fsLayoutQueued
+    fsLayoutQueued,
+    fsDrawing
     );
     );
   TFormStates = set of TFormState;
   TFormStates = set of TFormState;
 
 
@@ -99,8 +100,9 @@ type
     procedure DomChanged; override;
     procedure DomChanged; override;
     procedure Hide; virtual;
     procedure Hide; virtual;
     procedure Show; virtual;
     procedure Show; virtual;
-    procedure Invalidate; virtual;
+    procedure Invalidate; override;
     procedure InvalidateRect(const aRect: TFresnelRect); virtual;
     procedure InvalidateRect(const aRect: TFresnelRect); virtual;
+    function IsDrawing: boolean; override;
     property Designer: IFresnelFormDesigner read FDesigner write SetDesigner;
     property Designer: IFresnelFormDesigner read FDesigner write SetDesigner;
   public
   public
     // widgetset
     // widgetset
@@ -622,6 +624,11 @@ begin
     WSForm.InvalidateRect(aRect);
     WSForm.InvalidateRect(aRect);
 end;
 end;
 
 
+function TFresnelCustomForm.IsDrawing: boolean;
+begin
+  Result:=fsDrawing in FFormStates;
+end;
+
 procedure TFresnelCustomForm.CreateWSForm;
 procedure TFresnelCustomForm.CreateWSForm;
 begin
 begin
   if WSFormAllocated then exit;
   if WSFormAllocated then exit;
@@ -651,12 +658,19 @@ procedure TFresnelCustomForm.WSDraw;
 begin
 begin
   //FLLog(etDebug,'TFresnelCustomForm.WSDraw (%s)',[ToString]);
   //FLLog(etDebug,'TFresnelCustomForm.WSDraw (%s)',[ToString]);
   //FLLog(etDebug,'TFresnelCustomForm.WSDraw Have renderer: %b',[Assigned(Renderer)]);
   //FLLog(etDebug,'TFresnelCustomForm.WSDraw Have renderer: %b',[Assigned(Renderer)]);
-  LayoutQueued:=false;
-  if DomModified then
-  begin
-    ApplyCSS;
+  if fsDrawing in FFormStates then
+    raise Exception.Create('20250228113612 already drawing');
+  Include(FFormStates,fsDrawing);
+  try
+    LayoutQueued:=false;
+    if DomModified then
+    begin
+      ApplyCSS;
+    end;
+    Renderer.Draw(Self);
+  finally
+    Exclude(FFormStates,fsDrawing);
   end;
   end;
-  Renderer.Draw(Self);
 end;
 end;
 
 
 procedure TFresnelCustomForm.WSResize(const NewFormBounds: TFresnelRect;
 procedure TFresnelCustomForm.WSResize(const NewFormBounds: TFresnelRect;
@@ -695,15 +709,14 @@ end;
 
 
 class function TFresnelApplicationIdleEvent.FresnelEventID: TEventID;
 class function TFresnelApplicationIdleEvent.FresnelEventID: TEventID;
 begin
 begin
-  result:=evtIdle;
+  Result:=evtIdle;
 end;
 end;
 
 
-
 { TFresnelApplicationIdleEndEvent }
 { TFresnelApplicationIdleEndEvent }
 
 
 class function TFresnelApplicationIdleEndEvent.FresnelEventID: TEventID;
 class function TFresnelApplicationIdleEndEvent.FresnelEventID: TEventID;
 begin
 begin
-  result:=evtIdleEnd;
+  Result:=evtIdleEnd;
 end;
 end;
 
 
 { TFresnelApplicationActivateEvent }
 { TFresnelApplicationActivateEvent }