Browse Source

* Miter, cap, join, linedash, fillstyle-image

Michaël Van Canneyt 1 year ago
parent
commit
2bcb9a2b00
3 changed files with 167 additions and 20 deletions
  1. 126 18
      src/pas2js/fresnel.pas2js.wasmapi.pp
  2. 5 0
      src/wasm/fresnel.wasm.api.pp
  3. 36 2
      src/wasm/fresnel.wasm.shared.pp

+ 126 - 18
src/pas2js/fresnel.pas2js.wasmapi.pp

@@ -105,9 +105,11 @@ Type
     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 SetImageFillStyle(aID: TCanvasID; Flags : Longint; aImageWidth,aImageHeight: Longint; aImageData: TWasmPointer) : TCanvasError;
+    function SetLineCap(aID: TCanvasID; aCap: TCanvasLinecap): TCanvasError;
+    function SetLineJoin(aID: TCanvasID; aJoin: TCanvasLineJoin): TCanvasError;
     function SetLineMiterLimit(aID: TCanvasID; aWidth: TCanvasLineMiterLimit): TCanvasError;
+    function SetLineDash(aID: TCanvasID; aOffset : Longint; aPatternCount : longint; aPattern : TWasmPointer): TCanvasError;
     function SetLineWidth(aID: TCanvasID; aWidth: TCanvasLineWidth): TCanvasError;
     function SetStrokeStyle(aID: TCanvasID; aRed,aGreen,aBlue,aAlpha: TCanvasColorComponent): TCanvasError;
     function DrawImage(aID : TCanvasID; aX,aY,aWidth,aHeight,aImageWidth,aImageHeight: Longint; aImageData: TWasmPointer) : TCanvasError;
@@ -141,6 +143,12 @@ Implementation
 
 uses sysutils;
 
+Function UnScale(aLen : Longint) : Double;
+
+begin
+  Result:=aLen/100;
+end;
+
 { ---------------------------------------------------------------------
   FresnelHelper
   ---------------------------------------------------------------------}
@@ -474,11 +482,13 @@ begin
   aObject['canvas_filltext']:=@FillText;
   aObject['canvas_set_fillstyle']:=@SetFillStyle;
   aObject['canvas_linear_gradient_fillstyle']:=@SetLinearGradientFillStyle;
+  aObject['canvas_image_fillstyle']:=@SetImageFillStyle;
   aObject['canvas_set_strokestyle']:=@SetStrokeStyle;
   aObject['canvas_set_linewidth']:=@SetLineWidth;
   aObject['canvas_set_linecap']:=@SetLineCap;
   aObject['canvas_set_linejoin']:=@SetLineJoin;
   aObject['canvas_set_linemiterlimit']:=@SetLineMiterLimit;
+  aObject['canvas_set_linedash']:=@SetLineDash;
   aObject['canvas_draw_image']:=@DrawImage;
   aObject['canvas_set_font']:=@SetFont;
   aObject['canvas_measure_text']:=@MeasureText;
@@ -582,6 +592,46 @@ begin
   Exit(ECANVAS_SUCCESS);
 end;
 
+function TWasmFresnelApi.SetImageFillStyle(aID: TCanvasID; Flags: Longint;
+  aImageWidth, aImageHeight: Longint; aImageData: TWasmPointer): TCanvasError;
+
+
+
+var
+  OSC : TJSHTMLOffscreenCanvasElement;
+  ImgData : TJSImageData;
+//  OSCImgBitmap : TJSImageBitmap;
+  Canv,Canv2 : TJSCanvasRenderingContext2D;
+  D : TJSUint8ClampedArray;
+  V : TJSDataView;
+  S : String;
+
+begin
+  {$IFNDEF NOLOGAPICALLS}
+  If LogAPICalls then
+    begin
+    LogCall('Canvas.SetImageFillStyle(%d,%d,(%d,%d),[%x])',[aID,flags,aImageWidth,aImageHeight,aImageData]);
+    end;
+  {$ENDIF}
+  Canv:=GetCanvas(aID);
+  if Not Assigned(Canv) then
+    Exit(ECANVAS_NOCANVAS);
+  V:=getModuleMemoryDataView;
+  D:=TJSUint8ClampedArray.New(V.Buffer,aImageData,aImageWidth*aImageWidth*4);
+  ImgData:=TJSImageData.new(D,aImageWidth,aImageWidth);
+  OSC:=TJSHTMLOffscreenCanvasElement.New(aImageWidth,aImageHeight);
+  Canv2:=OSC.getContextAs2DContext('2d');
+  Canv2.clearRect(0,0,aImageWidth,aImageHeight);
+  Canv2.putImageData(ImgData,0,0);
+  Case flags and 3 of
+    IMAGEFILLSTYLE_NOREPEAT : s:='no-repeat';
+    IMAGEFILLSTYLE_REPEAT   : s:='repeat';
+    IMAGEFILLSTYLE_REPEATX  : s:='repeat-x';
+    IMAGEFILLSTYLE_REPEATY  : s:='repeat-y';
+  end;
+  Canv.fillStyleAsPattern:=Canv.createPattern(OSC,S);
+end;
+
 function TWasmFresnelApi.SetStrokeStyle(aID: TCanvasID; aRed, aGreen, aBlue, aAlpha: TCanvasColorComponent): TCanvasError;
 
 var
@@ -610,11 +660,11 @@ var
   V : TJSDataView;
   D : TJSUint8ClampedArray;
   ImgData : TJSImageData;
-  Canv2,Canv : TJSCanvasRenderingContext2D;
+  Canv : TJSCanvasRenderingContext2D;
 
 {$IFDEF IMAGE_USEOSC}
+  Canv2 : TJSCanvasRenderingContext2D;
   OSC : TJSHTMLOffscreenCanvasElement;
-  OSCImgBitmap : TJSImageBitmap;
 {$ENDIF}
 
 begin
@@ -635,10 +685,7 @@ begin
   Canv2:=OSC.getContextAs2DContext('2d');
   Canv2.clearRect(0,0,aImageWidth,aImageHeight);
   Canv2.putImageData(ImgData,0,0);
-  OSCImgBitmap:=OSC.transferToImageBitmap;
-  Canv.drawImage(OSCImgBitmap ,aX,aY,aWidth,aHeight);
-  OSCImgBitmap.close();
-
+  Canv.drawImage(OSC,aX,aY,aWidth,aHeight);
 {$ELSE}
 Window.createImageBitmap(ImgData)._then(
     function (res : jsvalue) : JSValue
@@ -734,7 +781,7 @@ begin
     Exit(ECANVAS_NOCANVAS);
   Canv.shadowOffsetX:=aOffsetX;
   Canv.shadowOffsetY:=aOffsetY;
-  Canv.shadowBlur:=aRadius/100;
+  Canv.shadowBlur:=UnScale(aRadius);
   Canv.shadowColor:=TFresnelHelper.FresnelColorToHTMLColor(aRed,aGreen,aBlue,aAlpha);
   Result:=ECANVAS_SUCCESS;
 end;
@@ -786,43 +833,64 @@ begin
   {$IFNDEF NOLOGAPICALLS}
   If LogAPICalls then
     begin
-    LogCall('Canvas.SetLineWidth(%d,%d)',[aID,Round(aWidth/100)]);
+    LogCall('Canvas.SetLineWidth(%d,%g)',[aID,Unscale(aWidth)]);
     end;
   {$ENDIF}
   Canv:=GetCanvas(aID);
   if Not Assigned(Canv) then
     Exit(ECANVAS_NOCANVAS);
-  Canv.LineWidth:=aWidth/100;
+  Canv.LineWidth:=UnScale(aWidth);
   Result:=ECANVAS_SUCCESS;
 end;
 
-function TWasmFresnelApi.SetLineCap(aID : TCanvasID; aWidth : TCanvasLinecap):  TCanvasError;
+function TWasmFresnelApi.SetLineCap(aID : TCanvasID; aCap : TCanvasLinecap):  TCanvasError;
+
+var
+  Canv:TJSCanvasRenderingContext2D;
+  S : String;
 
 begin
+  S:=LineCapToString(aCap);
   {$IFNDEF NOLOGAPICALLS}
   If LogAPICalls then
     begin
-    LogCall('Canvas.SetLineCap(%d,%d)',[aID,aWidth]);
+    LogCall('Canvas.SetLineCap(%d,%s)',[aID,S]);
     end;
   {$ENDIF}
-  LogCall('Canvas.SetLineCap not implemented');
+  Canv:=GetCanvas(aID);
+  if Not Assigned(Canv) then
+    Exit(ECANVAS_NOCANVAS);
+  Canv.lineCap:=S;
+  Result:=ECANVAS_SUCCESS;
 end;
 
-function TWasmFresnelApi.SetLineJoin(aID : TCanvasID; aWidth : TCanvasLineJoin):  TCanvasError;
+function TWasmFresnelApi.SetLineJoin(aID : TCanvasID; aJoin : TCanvasLineJoin):  TCanvasError;
+
+var
+  Canv:TJSCanvasRenderingContext2D;
+  S : String;
 
 begin
+  S:=LineJoinToString(aJoin);
   {$IFNDEF NOLOGAPICALLS}
   If LogAPICalls then
     begin
-    LogCall('Canvas.SetLineJoin(%d,%d)',[aID,aWidth]);
+    LogCall('Canvas.SetLineJoin(%d,%s)',[aID,S]);
     end;
   {$ENDIF}
-  LogCall('Canvas.SetLineJoin not implemented');
+  Canv:=GetCanvas(aID);
+  if Not Assigned(Canv) then
+    Exit(ECANVAS_NOCANVAS);
+  Canv.lineJoin:=S;
+  Result:=ECANVAS_SUCCESS;
 end;
 
 
 function TWasmFresnelApi.SetLineMiterLimit(aID : TCanvasID; aWidth : TCanvasLineMiterLimit):  TCanvasError;
 
+var
+  Canv:TJSCanvasRenderingContext2D;
+
 begin
   {$IFNDEF NOLOGAPICALLS}
   If LogAPICalls then
@@ -830,9 +898,49 @@ begin
     LogCall('Canvas.SetLineMiterLimit(%d,%d)',[aID,aWidth]);
     end;
   {$ENDIF}
+  Canv:=GetCanvas(aID);
+  if Not Assigned(Canv) then
+    Exit(ECANVAS_NOCANVAS);
+  Canv.miterLimit:=Unscale(aWidth);
+  Result:=ECANVAS_SUCCESS;
   LogCall('Canvas.SetLineMiterLimit not implemented');
 end;
 
+function TWasmFresnelApi.SetLineDash(aID: TCanvasID; aOffset: Longint;
+  aPatternCount: longint; aPattern: TWasmPointer): TCanvasError;
+
+var
+  Dashes : TJSArray;
+  V : TJSDataView;
+  I : Integer;
+  P : TWasmPointer;
+  Canv:TJSCanvasRenderingContext2D;
+
+begin
+  {$IFNDEF NOLOGAPICALLS}
+  If LogAPICalls then
+    begin
+    LogCall('Canvas.SetLineDash(%d,%g,%d,[%x])',[aID,Unscale(aOffset),aPatternCount,aPattern]);
+    end;
+  {$ENDIF}
+  Canv:=GetCanvas(aID);
+  if Not Assigned(Canv) then
+    Exit(ECANVAS_NOCANVAS);
+  Dashes:=TJSArray.New;
+  if aPatternCount>0 then
+    begin
+    V:=getModuleMemoryDataView;
+    P:=aPattern;
+    for I:=0 to APatternCount-1 do
+      begin
+      Dashes.Push(UnScale(v.Getint32(P,env.IsLittleEndian)));
+      Inc(P,4);
+      end;
+    end;
+  Canv.lineDashOffset:=Unscale(aOffset);
+  Canv.setLineDash(Dashes);
+end;
+
 
 { ---------------------------------------------------------------------
   Event API
@@ -1122,7 +1230,7 @@ Var
 
   function GetElement(aOffset : Longint) : Double;
   begin
-    Result:=V.getInt32(Data+(aOffset*4),Env.IsLittleEndian)/100;
+    Result:=UnScale(V.getInt32(Data+(aOffset*4),Env.IsLittleEndian));
   end;
 
   Procedure AddRadius(aRX,aRY : Double);

+ 5 - 0
src/wasm/fresnel.wasm.api.pp

@@ -188,6 +188,11 @@ function __fresnel_canvas_linear_gradient_fillstyle(aID : TCanvasID;
     aColorPoints : PGradientColorPoints
 ):  TCanvasError; external 'fresnel_api' name 'canvas_linear_gradient_fillstyle';
 
+function __fresnel_canvas_image_fillstyle(aID : TCanvasID;
+    aFlags,aImageWidth,aImageHeight : Longint;
+    aImageData : PByte
+):  TCanvasError; external 'fresnel_api' name 'canvas_image_fillstyle';
+
 // Image in RGBA
 function __fresnel_canvas_draw_image(
   aID : TCanvasID;

+ 36 - 2
src/wasm/fresnel.wasm.shared.pp

@@ -40,7 +40,7 @@ Type
   TCanvasLineWidth = longint; // Width * 100
   TCanvasLineCap = byte;
   TCanvasLineJoin = byte;
-  TCanvasLineMiterLimit = double;
+  TCanvasLineMiterLimit = longint;
 
   TCanvasMessageID = longint;
   TCanvasMessageParam = longint;
@@ -124,9 +124,11 @@ Const
    WASMSG_LEAVE       = 9;
    WASMSG_KEY      = 10;
 
-   // Roundrect data
+   // Roundrect flags
    ROUNDRECT_FLAG_FILL         = 1;
 
+   // Indexes for roundrect data array.
+
    ROUNDRECT_BOXTOPLEFTX       = 0;
    ROUNDRECT_BOXTOPLEFTY       = 1;
    ROUNDRECT_BOXBOTTOMRIGHTX   = 2;
@@ -140,9 +142,41 @@ Const
    ROUNDRECT_RADIIBOTTOMRIGHTX = 10;
    ROUNDRECT_RADIIBOTTOMRIGHTY = 11;
 
+   // Flags for SetImageFillStyle
+   IMAGEFILLSTYLE_NOREPEAT  = 0;
+   IMAGEFILLSTYLE_REPEAT    = 1;
+   IMAGEFILLSTYLE_REPEATX   = 2;
+   IMAGEFILLSTYLE_REPEATY   = 3;
+
+Function LineCapToString(aCap: TCanvasLineCap) : String;
+Function LineJoinToString(aJoin: TCanvasLineJoin) : String;
 
 implementation
 
+function LineCapToString(aCap: TCanvasLineCap): String;
+
+begin
+  Case aCap of
+    CANVAS_LINECAP_BUTT : Result:='butt';
+    CANVAS_LINECAP_ROUND : Result:='round';
+    CANVAS_LINECAP_SQUARE : Result:='square';
+  else
+    Result:='butt';
+  end;
+end;
+
+Function LineJoinToString(aJoin: TCanvasLineJoin) : String;
+
+begin
+  Case aJoin of
+    CANVAS_LINEJOIN_ROUND : Result:='round';
+    CANVAS_LINEJOIN_MITER : Result:='miter';
+    CANVAS_LINEJOIN_BEVEL : Result:='bevel';
+  else
+    Result:='round';
+  end;
+end;
+
 { TGradientColorPoint }
 
 function TGradientColorPoint.ToString: string;