* Implement additional APIs

src/pas2js/fresnel.pas2js.wasmapi.pp

@@ -64,6 +64,8 @@ Type
     function MouseToEvent(aEvent: TJSMouseEvent; aMessageID: TCanvasMessageID): TCanvasEvent;
     procedure PrepareCanvas;
     Procedure RemoveCanvas;
+    Procedure SendEvent;
+
   end;
   { TWasmFresnelApi }
 
@@ -94,11 +96,13 @@ Type
     function arc(aID : TCanvasID;X : Longint;Y : Longint;Radius : Longint;StartAngle : Double;EndAngle : Double):  TCanvasError; 
     function fillrect(aID : TCanvasID;  X : Longint; Y : Longint;  Width : Longint; Height : Longint): TCanvasError; 
     function strokerect(aID : TCanvasID;X : Longint;Y : Longint; Width : Longint; Height : Longint ):  TCanvasError; 
-    function clearrect(aID : TCanvasID;X : Longint;Y : Longint;Width : Longint; Height : Longint ):  TCanvasError; 
+    function clearrect(aID : TCanvasID;X : Longint;Y : Longint;Width : Longint; Height : Longint ):  TCanvasError;
+    function RoundRect(aID : TCanvasID; Flags : Longint; Data : TWasmPointer) : TCanvasError;
     function StrokeText(aID : TCanvasID;X : Longint;Y : Longint; aText : TWasmPointer; aTextLen : Longint ):  TCanvasError;
     function FillText(aID : TCanvasID;X : Longint;Y : Longint; aText : TWasmPointer; aTextLen : Longint ):  TCanvasError;
     function GetCanvasSizes(aID: TCanvasID; aWidth, aHeight: TWasmPointer): TCanvasError;
     function SetFillStyle(aID: TCanvasID; aRed,aGreen,aBlue,aAlpha: TCanvasColorComponent): TCanvasError;
+    function SetLinearGradientFillStyle(aID: TCanvasID; aStartX,aStartY,aEndX,aEndY : Longint; aColorPointCount : longint; aColorPoints : TWasmPointer) : TCanvasError;
     function SetLineCap(aID: TCanvasID; aWidth: TCanvasLinecap): TCanvasError;
     function SetLineJoin(aID: TCanvasID; aWidth: TCanvasLineJoin): TCanvasError;
     function SetLineMiterLimit(aID: TCanvasID; aWidth: TCanvasLineMiterLimit): TCanvasError;
@@ -107,6 +111,8 @@ Type
     function DrawImage(aID : TCanvasID; aX,aY,aWidth,aHeight,aImageWidth,aImageHeight: Longint; aImageData: TWasmPointer) : TCanvasError;
     function SetFont(aID : TCanvasID; aFontName : TWasmPointer; aFontNameLen : integer) : TCanvasError;
     function MeasureText(aID : TCanvasID; aText : TWasmPointer; aTextLen : integer; aWidth,aHeight : Longint) : TCanvasError;
+    function SetTextShadowParams (aID : TCanvasID;  aOffsetX,aOffsetY,aRadius : Longint;  aRed,aGreen,aBlue,aAlpha : TCanvasColorComponent): TCanvasError;
+
     // Timer
     function AllocateTimer(ainterval : longint; userdata: TWasmPointer) : TTimerID;
     procedure DeallocateTimer(timerid: TTimerID);
@@ -120,6 +126,7 @@ Type
   Public
     Constructor Create(aEnv : TPas2JSWASIEnvironment); override;
     Procedure FillImportObject(aObject : TJSObject); override;
+    Procedure ProcessMessages;
     Procedure StartTimerTick;
     Procedure StopTimerTick;
     Function ImportName : String; override;
@@ -193,6 +200,26 @@ end;
   TCanvasReference
   ---------------------------------------------------------------------}
 
+procedure TWasmFresnelApi.ProcessMessages;
+
+var
+  Callback : JSValue;
+begin
+  if not assigned(InstanceExports) then
+    Writeln('No instance exports !')
+  else
+    begin
+    Callback:=InstanceExports['__fresnel_process_message'];
+    if Assigned(Callback) then
+      begin
+      TTimerCallback(CallBack)(FLastTick,Now);
+      FLastTick:=Now;
+      end
+    else
+      Writeln('No processmessages callback !');
+    end
+end;
+
 procedure TWasmFresnelApi.DoTimerTick;
 
 var
@@ -248,6 +275,11 @@ begin
   canvascontext:=nil;
 end;
 
+procedure TCanvasReference.SendEvent;
+begin
+  API.ProcessMessages;
+end;
+
 function TCanvasReference.MouseToEvent(aEvent : TJSMouseEvent;aMessageID : TCanvasMessageID) : TCanvasEvent;
 
 var
@@ -262,8 +294,8 @@ var
 begin
   Result.CanvasID:=Self.CanvasID;
   Result.msg:=aMessageID;
-  Result.param0:=Round(aEvent.clientX);
-  Result.param1:=Round(aEvent.clientY);
+  Result.param0:=Round(aEvent.OffsetX);
+  Result.param1:=Round(aEvent.OffsetY);
   State:=[];
   Check(MOUSE_PRIMARY);
   Check(MOUSE_SECONDARY);
@@ -289,6 +321,7 @@ var
 begin
   Result:=True;
   TJSArray(API.FEvents).Push(MouseToEvent(evt,WASMSG_MOUSEDOWN));
+  SendEvent;
 end;
 
 function TCanvasReference.DoMouseMove(aEvent: TJSEvent): boolean;
@@ -299,6 +332,7 @@ var
 begin
   Result:=True;
   TJSArray(API.FEvents).Push(MouseToEvent(evt,WASMSG_MOVE));
+  SendEvent;
 end;
 
 function TCanvasReference.DoMouseWheel(aEvent: TJSEvent): boolean;
@@ -315,6 +349,7 @@ begin
     2 : CanvasEvt.Param3:=Round(JSEvt.deltaY*600); // arbitrary
   end;
   TJSArray(API.FEvents).Push(CanvasEvt);
+  SendEvent;
 end;
 
 function TCanvasReference.DoMouseClick(aEvent: TJSEvent): boolean;
@@ -325,6 +360,7 @@ var
 begin
   Result:=True;
   TJSArray(API.FEvents).Push(MouseToEvent(evt,WASMSG_CLICK));
+  SendEvent;
 end;
 
 function TCanvasReference.DoMouseDblClick(aEvent: TJSEvent): boolean;
@@ -334,6 +370,7 @@ var
 begin
   Result:=True;
   TJSArray(API.FEvents).Push(MouseToEvent(evt,WASMSG_DBLCLICK));
+  SendEvent;
 end;
 
 
@@ -345,6 +382,7 @@ var
 begin
   Result:=True;
   TJSArray(API.FEvents).Push(MouseToEvent(evt,WASMSG_MOUSEUP));
+  SendEvent;
 end;
 
 
@@ -433,6 +471,7 @@ begin
   aObject['canvas_stroketext']:=@StrokeText;
   aObject['canvas_filltext']:=@FillText;
   aObject['canvas_set_fillstyle']:=@SetFillStyle;
+  aObject['canvas_linear_gradient_fillstyle']:=@SetLinearGradientFillStyle;
   aObject['canvas_set_strokestyle']:=@SetStrokeStyle;
   aObject['canvas_set_linewidth']:=@SetLineWidth;
   aObject['canvas_set_linecap']:=@SetLineCap;
@@ -441,7 +480,12 @@ begin
   aObject['canvas_draw_image']:=@DrawImage;
   aObject['canvas_set_font']:=@SetFont;
   aObject['canvas_measure_text']:=@MeasureText;
+  aObject['canvas_set_textshadow_params']:=@SetTextShadowParams;
+  aObject['canvas_roundrect']:=@RoundRect;
 
+  // Timer
+  aObject['timer_allocate']:=@AllocateTimer;
+  aObject['timer_deallocate']:=@DeAllocateTimer;
   // Event
   aObject['event_get']:=@GetEvent;
   aObject['event_count']:=@GetEventCount;
@@ -476,7 +520,6 @@ var
   S : String;
 
 begin
-  // Writeln('SFS : ',aID,',',aRed,',',aGreen,',',aBlue,',',aAlpha);
   {$IFNDEF NOLOGAPICALLS}
   If LogAPICalls then
     begin
@@ -492,6 +535,51 @@ begin
   Exit(ECANVAS_SUCCESS);
 end;
 
+function TWasmFresnelApi.SetLinearGradientFillStyle(aID: TCanvasID; aStartX, aStartY, aEndX, aEndY: Longint;
+  aColorPointCount: longint; aColorPoints: TWasmPointer): TCanvasError;
+
+var
+  I,P : Longint;
+  Red,Green,Blue,Alpha: Longint;
+  offset : double;
+  G : TJSCanvasGradient;
+  Canv : TJSCanvasRenderingContext2D;
+  V : TJSDataView;
+  S : String;
+
+  function GetLongint: longint;
+  begin
+    Result:=V.getInt32(P,Env.IsLittleEndian);
+    Inc(P,4);
+  end;
+
+begin
+  {$IFNDEF NOLOGAPICALLS}
+  If LogAPICalls then
+    begin
+    LogCall('Canvas.SetLinearGradientFillStyle(%d,(%d,%d),(%d,%d),%d,[%x])',[aID,aStartX, aStartY, aEndX, aEndY, aColorPointCount,aColorPoints]);
+    end;
+  {$ENDIF}
+  Canv:=GetCanvas(aID);
+  if Not Assigned(Canv) then
+    Exit(ECANVAS_NOCANVAS);
+  G:=Canv.createLinearGradient(aStartX,aStartY,aEndX,aEndY);
+  V:=getModuleMemoryDataView;
+  P:=aColorPoints;
+  For I:=0 to aColorPointCount-1 do
+    begin
+    Red:=GetLongint;
+    Green:=GetLongint;
+    Blue:=GetLongint;
+    Alpha:=GetLongint;
+    offset:=GetLongint/10000;
+    S:=TFresnelHelper.FresnelColorToHTMLColor(Red,Green,Blue,Alpha);
+    G.addColorStop(offset,S);
+    end;
+  Canv.fillStyleAsGradient:=G;
+  Exit(ECANVAS_SUCCESS);
+end;
+
 function TWasmFresnelApi.SetStrokeStyle(aID: TCanvasID; aRed, aGreen, aBlue, aAlpha: TCanvasColorComponent): TCanvasError;
 
 var
@@ -540,7 +628,7 @@ begin
     var
       ImgBitmap : TJSImageBitmap absolute res;
     begin
-      Canv.drawImage(ImgBitmap,aX,aY);
+      Canv.drawImage(ImgBitmap,aX,aY,aWidth,aHeight);
     end);
   Result:=ECANVAS_SUCCESS;
 end;
@@ -611,7 +699,29 @@ begin
   Result:=ECANVAS_SUCCESS;
 end;
 
-function TWasmFresnelApi.AllocateTimer(aInterval: longint; userdata: TWasmPointer): TTimerID;
+function TWasmFresnelApi.SetTextShadowParams (aID : TCanvasID;  aOffsetX,aOffsetY,aRadius : Longint;  aRed,aGreen,aBlue,aAlpha : TCanvasColorComponent): TCanvasError;
+
+var
+  Canv:TJSCanvasRenderingContext2D;
+
+begin
+  {$IFNDEF NOLOGAPICALLS}
+  If LogAPICalls then
+    begin
+    LogCall('Canvas.SetTextShadowParams(%d,%d,%d,%d,"%s")',[aID,aOffsetX,aOffsetY,aRadius,TFresnelHelper.FresnelColorToHTMLColor(aRed,aGreen,aBlue,aAlpha)]);
+    end;
+  {$ENDIF}
+  Canv:=GetCanvas(aID);
+  if Not Assigned(Canv) then
+    Exit(ECANVAS_NOCANVAS);
+  Canv.shadowOffsetX:=aOffsetX;
+  Canv.shadowOffsetY:=aOffsetY;
+  Canv.shadowBlur:=aRadius/100;
+  Canv.shadowColor:=TFresnelHelper.FresnelColorToHTMLColor(aRed,aGreen,aBlue,aAlpha);
+  Result:=ECANVAS_SUCCESS;
+end;
+
+function TWasmFresnelApi.AllocateTimer(ainterval: longint; userdata: TWasmPointer): TTimerID;
 
 var
   aTimerID : TTimerID;
@@ -984,6 +1094,51 @@ begin
     end;
 end;
 
+function TWasmFresnelApi.RoundRect(aID: TCanvasID; Flags: Longint; Data: TWasmPointer): TCanvasError;
+Var
+  C : TJSCanvasRenderingContext2D;
+  V : TJSDataView;
+  X,Y,W,H : Double;
+  Radii : TJSArray;
+  Fill : Boolean;
+
+  function GetElement(aOffset : Longint) : Double;
+  begin
+    Result:=V.getInt32(Data+(aOffset*4),Env.IsLittleEndian)/100;
+  end;
+
+  Procedure AddRadius(aRX,aRY : Double);
+  begin
+    Radii.Push(New(['x',aRX,'y',aRY]))
+  end;
+
+begin
+  {$IFNDEF NOLOGAPICALLS}
+  If LogAPICalls then
+    LogCall('Canvas.RoundRect(%d,%d,[%d])',[aID,Flags,Data]);
+  {$ENDIF}
+  C:=GetCanvas(aID);
+  if not Assigned(C) then
+    Exit(ECANVAS_NOCANVAS);
+  V:=getModuleMemoryDataView;
+  X:=GetElement(ROUNDRECT_BOXTOPLEFTX);
+  Y:=GetElement(ROUNDRECT_BOXTOPLEFTY);
+  W:=GetElement(ROUNDRECT_BOXBOTTOMRIGHTX)-X;
+  H:=GetElement(ROUNDRECT_BOXBOTTOMRIGHTY)-Y;
+  Fill:=(Flags and ROUNDRECT_FLAG_FILL)<>0;
+  Radii:=TJSArray.New;
+  AddRadius(GetElement(ROUNDRECT_RADIITOPLEFTX),GetElement(ROUNDRECT_RADIITOPLEFTY));
+  AddRadius(GetElement(ROUNDRECT_RADIITOPRIGHTX),GetElement(ROUNDRECT_RADIITOPRIGHTY));
+  AddRadius(GetElement(ROUNDRECT_RADIIBOTTOMRIGHTX),GetElement(ROUNDRECT_RADIIBOTTOMRIGHTY));
+  AddRadius(GetElement(ROUNDRECT_RADIIBOTTOMLEFTX),GetElement(ROUNDRECT_RADIIBOTTOMLEFTY));
+  C.BeginPath;
+  C.roundRect(X,Y,W,H,Radii);
+  if Fill then
+    C.fill;
+  C.stroke();
+  Result:=ECANVAS_SUCCESS;
+end;
+
 function TWasmFresnelApi.StrokeText(aID: TCanvasID; X: Longint; Y: Longint; aText: TWasmPointer; aTextLen: Longint): TCanvasError;
 
 Var

src/wasm/fresnel.wasm.api.pp

@@ -81,6 +81,11 @@ function __fresnel_canvas_strokerect(
   Height : Longint
 ):  TCanvasError; external 'fresnel_api' name 'canvas_strokerect';
 
+function __fresnel_canvas_roundrect(
+  aID : TCanvasID;
+  aFlags : longint;
+  aData : PCanvasRoundRectData
+):  TCanvasError; external 'fresnel_api' name 'canvas_roundrect';
 
 function __fresnel_canvas_clearrect(
   aID : TCanvasID;
@@ -156,6 +161,17 @@ function __fresnel_canvas_measure_text(
   aHeight : PLongint
 ):  TCanvasError; external 'fresnel_api' name 'canvas_measure_text';
 
+function __fresnel_canvas_set_textshadow_params (aID : TCanvasID;
+    aOffsetX,aOffsetY,aRadius : Longint;
+    aRed,aGreen,aBlue,aAlpha : Longint
+):  TCanvasError; external 'fresnel_api' name 'canvas_set_textshadow_params';
+
+function __fresnel_canvas_linear_gradient_fillstyle(aID : TCanvasID;
+    aStartX,aStartY,aEndX,aEndY : Longint;
+    aColorPointCount : longint;
+    aColorPoints : PGradientColorPoints
+):  TCanvasError; external 'fresnel_api' name 'canvas_linear_gradient_fillstyle';
+
 // Image in RGBA
 function __fresnel_canvas_draw_image(
   aID : TCanvasID;
@@ -218,6 +234,7 @@ implementation
 procedure __fresnel_tick (aCurrent,aPrevious : double);
 
 begin
+  Writeln('Tick');
   if assigned(OnFresnelWasmTick) then
     OnFresnelWasmTick(aCurrent,aPrevious);
 end;

src/wasm/fresnel.wasm.shared.pp

@@ -2,6 +2,8 @@ unit fresnel.wasm.shared;
 
 {$mode objfpc}{$H+}
 {$modeswitch typehelpers}
+{$modeswitch advancedrecords}
+
 interface
 
 uses
@@ -15,6 +17,7 @@ const
   CanvasMsgSize = 4;
 
 Type
+
   TCanvasError = longint;
   TCanvasID = longint;
   TCanvasColorComponent = Word; // one of R G B A
@@ -32,6 +35,16 @@ Type
   {$ENDIF}
 
   TTimerID = longint;
+  TCanvasRoundRectData = Array[0..11] of longint;
+
+  { TGradientColorPoint }
+
+  TGradientColorPoint = record
+    Red,Green,Blue,Alpha : longint;
+    Percentage : longint; // Scaled 100
+    function ToString : string;
+  end;
+  TGradientColorPoints = Array of TGradientColorPoint;
 
   { TCanvasMessageDataHelper }
 
@@ -44,6 +57,8 @@ Type
   PCanvasColor = ^TCanvasColor;
   PCanvasMessageID = ^TCanvasMessageID;
   PCanvasMessageData = ^TCanvasMessageData;
+  PCanvasRoundRectData = ^TCanvasRoundRectData;
+  PGradientColorPoints = ^TGradientColorPoint;
   {$ENDIF}
 
 Const
@@ -94,8 +109,32 @@ Const
    WASMSG_LEAVE       = 9;
    WASMSG_KEY      = 10;
 
+   // Roundrect data
+   ROUNDRECT_FLAG_FILL         = 1;
+
+   ROUNDRECT_BOXTOPLEFTX       = 0;
+   ROUNDRECT_BOXTOPLEFTY       = 1;
+   ROUNDRECT_BOXBOTTOMRIGHTX   = 2;
+   ROUNDRECT_BOXBOTTOMRIGHTY   = 3;
+   ROUNDRECT_RADIITOPLEFTX     = 4;
+   ROUNDRECT_RADIITOPLEFTY     = 5;
+   ROUNDRECT_RADIITOPRIGHTX    = 6;
+   ROUNDRECT_RADIITOPRIGHTY    = 7;
+   ROUNDRECT_RADIIBOTTOMLEFTX  = 8;
+   ROUNDRECT_RADIIBOTTOMLEFTY  = 9;
+   ROUNDRECT_RADIIBOTTOMRIGHTX = 10;
+   ROUNDRECT_RADIIBOTTOMRIGHTY = 11;
+
+
 implementation
 
+{ TGradientColorPoint }
+
+function TGradientColorPoint.ToString: string;
+begin
+  Result:=Format('{%g%% (r:%d, g:%d, b:%d / %d)}',[Percentage/100,Red,Green,Blue,Alpha]);
+end;
+
 { TCanvasMessageDataHelper }
 
 function TCanvasMessageDataHelper.ToString: UTF8String;