* Menu API

src/pas2js/fresnel.pas2js.wasmapi.pp

@@ -29,18 +29,27 @@ Type
     isSpecial : Boolean;
     KeyCode : Longint;
   end;
+  TClipRect = record
+    x,y,w,h : Single;
+  end;
+  TTransform = record
+    m11,m12,m21,m22,m31,m32 : TFresnelFloat;
+  end;
 
   { TFresnelHelper }
 
   TFresnelHelper = Class
   Private
-    class var _CurrentID : TCanvasID;
+    class var
+     _CurrentID : TCanvasID;
+     _CurrentMenuID : TMenuID;
   Public
     Class function FresnelColorToHTMLColor(aColor : TCanvasColor) : string;
     Class function FresnelColorToHTMLColor(aRed, aGreen, aBlue, aAlpha: TCanvasColorComponent): string;
     class Function MouseButtonToShiftState(aButton: Integer): TShiftStateEnum;
     Class Function ShiftStateToInt(aState : TShiftState) : Integer;
     Class Function AllocateCanvasID : TCanvasID;
+    Class Function AllocateMenuID : TMenuID;
   end;
 
   { TCanvasEvent }
@@ -56,6 +65,37 @@ Type
     constructor Create(aCanvasID : TCanvasID; aMsg : TCanvasMessageID; p0 : TCanvasMessageParam; p1: TCanvasMessageParam = 0; p2: TCanvasMessageParam = 0;p3: TCanvasMessageParam = 0);
   end;
 
+  { TMainMenuBuilder }
+  TMenuFlag = (mfInvisible,mfChecked,mfRadio);
+  TMenuFlags = set of TMenuFlag;
+
+  TMainMenuBuilder = Class(TObject)
+  private
+    FApi: TWasmFresnelApi;
+    FMenuParent: TJSHTMLElement;
+  protected
+    Procedure DoMenuClick(aEvent : TJSEvent);
+    function DoAddMenuItem(aParentID,aMenuID : TMenuID; aCaption : String; Flags : TMenuFlags; ShortCut : Longint; aData : TWasmPointer) : TJSHTMLElement; virtual; abstract;
+    function DoRemoveMenuItem(aMenuID : TMenuID) : Boolean; virtual; abstract;
+    function DoUpdateMenuItem(aMenuID : TMenuID; aFlags : TMenuFlags; aFlagsToUpdate : TMenuFlags) : boolean; virtual; abstract;
+  Public
+    Constructor Create(aApi : TWasmFresnelApi; aMenuParent : TJSHTMLElement); virtual;
+    function AddMenuItem(aParentID,aMenuID : TMenuID; aCaption : String; Flags : TMenuFlags; ShortCut : Longint; aData : TWasmPointer) : TJSHTMLElement;
+    function RemoveMenuItem(aMenuID : TMenuID) : Boolean;
+    function UpdateMenuItem(aMenuID : TMenuID; aFlags : TMenuFlags; aFlagsToUpdate : TMenuFlags) : boolean;
+    Property MenuParent : TJSHTMLElement Read FMenuParent;
+    Property API : TWasmFresnelApi Read FApi;
+  end;
+
+  { TDefaultMainMenuBuilder }
+  TDefaultMainMenuBuilder = class(TMainMenuBuilder)
+  Protected
+    function FindMenuElement(aMenuID: Integer): TJSHTMLElement;
+    function DoAddMenuItem(aParentID, aMenuID: TMenuID; aCaption: String; Flags : TMenuFlags; ShortCut : Longint; aData: TWasmPointer): TJSHTMLElement; override;
+    function DoRemoveMenuItem(aMenuID : TMenuID) : Boolean; override;
+    function DoUpdateMenuItem(aMenuID : TMenuID; aFlags : TMenuFlags; aFlagsToUpdate : TMenuFlags) : boolean; override;
+  end;
+
   { TCanvasReference }
   TCanvasType = (ctElement,ctOffscreen);
 
@@ -66,12 +106,19 @@ Type
     FFont: String;
     FStrokeStyle: JSValue;
     FTitle: String;
-
+    FClipRects : Array of TClipRect;
+    FLastTransform : TTransform;
     procedure InitProperties;
+    procedure SaveTransform(m11, m12, m21, m22, m31, m32: TFresnelFloat);
     procedure SetFillStyle(AValue: JSValue);
     procedure SetFont(AValue: String);
     procedure SetStrokeStyle(AValue: JSValue);
     procedure SetTextBaseLine(AValue: String);
+    procedure SetClipPath;
+    procedure AddClipRect(aRect : TClipRect);
+    procedure SaveState;
+    procedure RestoreState(aApplyProperties: Boolean);
+    function SetTransform(m11,m12,m21,m22,m31,m32 : TFresnelFloat; DoReset : Boolean) : TCanvasError;
     function DoMouseClick(aEvent: TJSEvent): boolean;
     function DoMouseDblClick(aEvent: TJSEvent): boolean;
     function DoMouseDown(aEvent: TJSEvent): boolean;
@@ -89,6 +136,7 @@ Type
     windowtitle,
     canvasParent :TJSHTMLElement;
     FTextBaseLine : String;
+    FMenuBuilder : TMainMenuBuilder;
     constructor Create(aID : TCanvasID; aAPI : TWasmFresnelApi; aCanvas : TJSHTMLCanvasElement; aParent : TJSHTMLElement);
     constructor CreateOffScreen(aID : TCanvasID;aAPI : TWasmFresnelApi; aWidth,aHeight: Longint);
     procedure PrepareCanvas;
@@ -101,13 +149,19 @@ Type
     property Font : String Read FFont Write SetFont;
     property Title : String Read FTitle Write SetTitle;
     property CanvasType : TCanvasType Read FCanvasType;
+    property MenuBuilder : TMainMenuBuilder Read FMenuBuilder Write FMenuBuilder;
   end;
+
+
   { TWasmFresnelApi }
 
   TTimerCallback = Procedure (aCurrent,aPrevious : Double);
+  TMenuClickCallback = Procedure (aMenuID : TMenuID; aUserData : TWasmPointer);
   TDebugApi = (daText,daClipRect);
   TDebugApis = Set of TDebugApi;
 
+
+
   TWasmFresnelApi = class(TImportExtension)
   Public
     class var
@@ -122,13 +176,11 @@ Type
     FFocusedCanvas: TCanvasReference;
     FLastFocused: TCanvasReference;
     FLogAPICalls : Boolean;
+    FMenuSupport: Boolean;
     FTimerID : NativeInt;
     FTimerInterval: NativeInt;
     FLastTick: TDateTime;
     FKeyMap : TJSObject;
-    procedure DrawBaseLine(C: TJSCanvasRenderingContext2D; S: String; X, Y: Double);
-    procedure DrawClipRect(Ref: TCanvasReference; aX, aY, aWidth,
-      aHeight: double);
     procedure SetCreateDefaultCanvas(AValue: Boolean);
     procedure SetFocusedCanvas(AValue: TCanvasReference);
   Protected
@@ -137,6 +189,10 @@ Type
     Procedure LogCall(Const Fmt : String; const Args : Array of const);
     function GetCanvas(aID : TCanvasID) : TJSCanvasRenderingContext2D;
     function GetCanvasRef(aID: TCanvasID): TCanvasReference;
+    function CreateMenuBuilder(aParent: TJSHTMLELement): TMainMenuBuilder; virtual;
+    // Debug
+    procedure DrawBaseLine(C: TJSCanvasRenderingContext2D; S: String; X, Y: Double);
+    procedure DrawClipRect(Ref: TCanvasReference; aX, aY, aWidth, aHeight: double);
     // Canvas
     function allocatecanvas(SizeX, SizeY : Longint; aID: TWasmPointer): TCanvasError;
     function allocateoffscreencanvas(SizeX, SizeY : Longint; aBitmap : TWasmPointer; aID: TWasmPointer): TCanvasError;
@@ -186,6 +242,11 @@ Type
     // Events
     function GetEvent(aID: TWasmPointer; aMsg: TWasmPointer; Data : TWasmPointer): TCanvasError;
     function GetEventCount(aCount: TWasmPointer): TCanvasError;
+    // Menu
+    Function HandleMenuClick(aMenuID : TMenuID; aData : TWasmPointer) : Boolean;
+    function AddMenuItem(aCanvasID : TCanvasId; aParentID : TMenuID; aCaption : TWasmPointer; aCaptionLen : Longint; aData: TWasmPointer; aFlags : Longint; aShortCut : Longint; aMenuID : PMenuID) : TCanvasError;
+    function DeleteMenuItem(aCanvasID : TCanvasId; aMenuID : TMenuID) : TCanvasError;
+    function UpdateMenuItem(aCanvasID : TCanvasId; aMenuID : TMenuID; aFlags : Longint; aShortCut : Longint) : TCanvasError;
     // Key handlers are global
     function DoKeyDownEvent(aEvent: TJSEvent): boolean;
     function DoKeyUpEvent(aEvent: TJSEvent): boolean;
@@ -213,6 +274,7 @@ Type
     Property CanvasParent : TJSHTMLELement Read FCanvasParent Write FCanvasParent;
     Property CreateDefaultCanvas : Boolean read FCreateDefaultCanvas Write SetCreateDefaultCanvas;
     Property LogAPICalls : Boolean Read FLogAPICalls Write FLogAPICalls;
+    Property MenuSupport : Boolean Read FMenuSupport Write FMenuSupport;
     Property TimerInterval : NativeInt Read FTimerInterval Write FTimerInterval;
     Property DebugAPIs : TDebugApis Read FDebugApis Write FDebugApis;
   end;
@@ -221,6 +283,22 @@ Implementation
 
 uses sysutils;
 
+Function FlagsToMenuFlags(Flags : Longint) : TMenuFlags;
+
+  procedure add(aFlag: Longint; aMenuFlag : TMenuFlag);
+
+  begin
+    if (Flags and aFlag)=aFlag then
+      Include(Result,aMenuFlag);
+  end;
+
+begin
+  Result:=[];
+  Add(MENU_FLAGS_INVISIBLE,mfInvisible);
+  Add(MENU_FLAGS_CHECKED,mfChecked);
+  Add(MENU_FLAGS_RADIO,mfRadio);
+end;
+
 type
 
   { TJSKeyNameObjectCreator }
@@ -279,7 +357,7 @@ begin
     end;
 end;
 
-class Function TFresnelHelper.ShiftStateToInt(aState : TShiftState) : Integer;
+class function TFresnelHelper.ShiftStateToInt(aState: TShiftState): Integer;
 
 var
   S : TShiftStateEnum;
@@ -401,6 +479,60 @@ begin
   canvascontext.textBaseline:=aValue;
 end;
 
+procedure TCanvasReference.SetClipPath;
+
+var
+  P : TJSPath2D;
+  R : TClipRect;
+begin
+  RestoreState(True);
+  SaveState;
+  if Length(FClipRects)=0 then
+    exit;
+  P:=TJSPath2D.New;
+  For R in FClipRects do
+    P.Rect(R.X,R.Y,R.w,R.h);
+  CanvasContext.Clip(P);
+end;
+
+procedure TCanvasReference.AddClipRect(aRect: TClipRect);
+begin
+  TJSArray(FClipRects).Push(aRect)
+end;
+
+procedure TCanvasReference.SaveState;
+begin
+  CanvasContext.Save;
+end;
+
+procedure TCanvasReference.RestoreState(aApplyProperties : Boolean);
+begin
+  CanvasContext.Restore;
+  ApplyProperties;
+end;
+
+procedure TCanvasReference.SaveTransform(m11,m12,m21,m22,m31,m32: TFresnelFloat);
+
+begin
+  FLastTransform.m11:=m11;
+  FLastTransform.m12:=m12;
+  FLastTransform.m21:=m21;
+  FLastTransform.m22:=m22;
+  FLastTransform.m31:=m31;
+  FLastTransform.m32:=m32;
+end;
+
+function TCanvasReference.SetTransform(m11, m12, m21, m22, m31, m32: TFresnelFloat; DoReset: Boolean): TCanvasError;
+begin
+  if DoReset  then
+    begin
+    CanvasContext.setTransform(m11,m12,m21,m22,m31,m32);
+    SaveTransform(m11,m12,m21,m22,m31,m32);
+    end
+  else
+    CanvasContext.transform(m11,m12,m21,m22,m31,m32);
+end;
+
 procedure TCanvasReference.PrepareCanvas;
 
 begin
@@ -411,6 +543,7 @@ begin
   Canvas.AddEventListener('click',@DoMouseClick);
   Canvas.AddEventListener('dblclick',@DoMouseDblClick);
   Canvas.AddEventListener('scroll',@DoMouseWheel);
+  FClipRects:=[];
   InitProperties;
 end;
 
@@ -435,6 +568,12 @@ begin
   FFillStyle    := canvascontext.fillStyle;
   FStrokeStyle  := canvascontext.strokeStyle;
   FFont         := canvascontext.font;
+  FLastTransform.m11:=1;
+  FLastTransform.m12:=0;
+  FLastTransform.m21:=0;
+  FLastTransform.m32:=1;
+  FLastTransform.m31:=0;
+  FLastTransform.m32:=0;
 end;
 
 procedure TCanvasReference.ApplyProperties;
@@ -443,6 +582,8 @@ begin
   canvascontext.fillStyle:=FFillStyle;
   canvascontext.strokeStyle:=FStrokeStyle;
   canvascontext.font:=FFont;
+  With FLastTransform do
+    canvascontext.setTransform(m11,m12,m21,m22,m31,m32);
 end;
 
 function TCanvasReference.MouseToEvent(aEvent : TJSMouseEvent;aMessageID : TCanvasMessageID) : TCanvasEvent;
@@ -525,7 +666,7 @@ begin
   SendEvent;
 end;
 
-Class function TCanvasReference.EncodeShiftState(keyEvent : TJSKeyboardEvent) : longint;
+class function TCanvasReference.EncodeShiftState(keyEvent: TJSKeyboardEvent): longint;
 
 
 var
@@ -622,6 +763,116 @@ begin
   SendEvent;
 end;
 
+{ TMainMenuBuilder }
+
+procedure TMainMenuBuilder.DoMenuClick(aEvent: TJSEvent);
+
+var
+  S : String;
+  MenuID : integer;
+  UserData : TWasmPointer;
+  menuEl : TJSHTMLElement;
+
+begin
+  MenuEl:=TJSHTMLElement(aEvent.currentTargetHTMLElement.parentElement);
+  S:=MenuEl.dataset['menuId'];
+  MenuID:=StrToIntDef(S,-1);
+  S:=MenuEl.dataset['menuUserData'];
+  UserData:=StrToIntDef(S,-1);
+  if (UserData<>-1) and (MenuID<>-1) then
+    Api.HandleMenuClick(MenuID,UserData);
+end;
+
+constructor TMainMenuBuilder.Create(aApi: TWasmFresnelApi; aMenuParent: TJSHTMLElement);
+begin
+  FAPI:=aApi;
+  FMenuParent:=aMenuParent;
+end;
+
+function TMainMenuBuilder.AddMenuItem(aParentID,aMenuID: TMenuID; aCaption: String; Flags : TMenuFlags; ShortCut : Longint; aData: TWasmPointer): TJSHTMLElement;
+begin
+  Result:=DoAddMenuItem(aParentID,aMenuID,aCaption,Flags,ShortCut,aData);
+end;
+
+function TMainMenuBuilder.RemoveMenuItem(aMenuID: TMenuID): Boolean;
+begin
+  Result:=DoRemoveMenuItem(aMenuID);
+end;
+
+function TMainMenuBuilder.UpdateMenuItem(aMenuID: TMenuID; aFlags: TMenuFlags; aFlagsToUpdate: TMenuFlags): boolean;
+begin
+  Result:=DoUpdateMenuItem(aMenuID,aFlags,aFlagsToUpdate);
+end;
+
+{ TDefaultMainMenuBuilder }
+
+function TDefaultMainMenuBuilder.FindMenuElement(aMenuID : Integer) : TJSHTMLElement;
+
+begin
+  Result:=TJSHTMLElement(MenuParent.querySelector('li[data-menu-id="'+IntToStr(aMenuID)+'"]'))
+end;
+
+function TDefaultMainMenuBuilder.DoAddMenuItem(aParentID,aMenuID: TMenuID; aCaption: String; Flags : TMenuFlags; ShortCut : Longint; aData: TWasmPointer): TJSHTMLElement;
+
+var
+  CaptionEl,MenuEl,ListEl,parentEl : TJSHTMLElement;
+
+begin
+  Result:=nil;
+  if AParentID=0 then
+    ParentEl:=MenuParent
+  else
+    ParentEl:=FindMenuElement(aParentID);
+  if Not assigned(ParentEl) then exit;
+  ListEl:=TJSHTMLElement(ParentEl.QuerySelector('ul'));
+  if Not Assigned(ListEl) then
+    begin
+    ListEl:=TJSHTMLElement(Document.createElement('ul'));
+    if ParentEl=MenuParent then
+      ListEl.classList.Add('fresnel-mainmenu')
+    else
+      ListEl.classList.Add('fresnel-submenu');
+    ParentEl.appendChild(ListEl);
+    end;
+  MenuEl:=TJSHTMLElement(Document.CreateElement('li'));
+  ListEl.appendChild(MenuEl);
+  MenuEl.dataset.Map['menuId']:=IntToStr(aMenuID);
+  MenuEl.dataset.Map['menuUserData']:=IntToStr(aData);
+  if aCaption='-' then
+    begin
+    MenuEl.ClassList.add('fresnel-menu-separator');
+    CaptionEl:=TJSHTMLElement(Document.CreateElement('hr'))
+    end
+  else
+    begin
+    MenuEl.classList.Add('fresnel-menu-item');
+    CaptionEl:=TJSHTMLElement(Document.CreateElement('span'));
+    if mfChecked in Flags then
+      aCaption:=#$2611+' '+aCaption;
+    CaptionEl.InnerText:=aCaption;
+    CaptionEl.AddEventListener('click',@DoMenuClick);
+    end;
+  MenuEl.appendChild(CaptionEl);
+  Result:=MenuEl;
+end;
+
+function TDefaultMainMenuBuilder.DoRemoveMenuItem(aMenuID: TMenuID) : Boolean;
+
+var
+  El : TJSHTMLElement;
+
+begin
+  El:=FindMenuElement(aMenuID);
+  Result:=Assigned(El);
+  if Result then
+    El.parentElement.removeChild(El);
+end;
+
+function TDefaultMainMenuBuilder.DoUpdateMenuItem(aMenuID: TMenuID; aFlags: TMenuFlags; aFlagsToUpdate: TMenuFlags): boolean;
+begin
+  Result:=False;
+end;
+
 
 constructor TWasmFresnelApi.Create(aEnv: TPas2JSWASIEnvironment);
 
@@ -693,12 +944,23 @@ begin
     Result:=nil;
 end;
 
+function TWasmFresnelApi.CreateMenuBuilder(aParent : TJSHTMLELement): TMainMenuBuilder;
+begin
+  Result:=TDefaultMainMenuBuilder.Create(Self,aParent);
+end;
+
 class function TFresnelHelper.AllocateCanvasID: TCanvasID;
 begin
   Inc(_CurrentID);
   Result:=_CurrentID;
 end;
 
+class function TFresnelHelper.AllocateMenuID: TMenuID;
+begin
+  Inc(_CurrentMenuID);
+  Result:=_CurrentMenuID;
+end;
+
 { TCanvasEvent }
 
 constructor TCanvasEvent.Create(aCanvasID: TCanvasID; aMsg: TCanvasMessageID);
@@ -804,6 +1066,9 @@ begin
   aObject['event_get']:=@GetEvent;
   aObject['event_count']:=@GetEventCount;
   aObject['event_set_special_keymap']:=@SetSpecialKeyMap;
+  aObject['menu_add_item']:=@AddMenuItem;
+  aObject['menu_remove_item']:=@DeleteMenuItem;
+  aObject['menu_update_item']:=@UpdateMenuItem;
 end;
 
 procedure TWasmFresnelApi.StartTimerTick;
@@ -878,7 +1143,7 @@ begin
 
 end;
 
-function TWasmFresnelApi.GetCanvasSizes(aID: TCanvasID; aWidth, aHeight: TWasmPointer): TCanvasError;
+function TWasmFresnelApi.GetCanvasSizes(aID: TCanvasID; aWidth, aHeight: PFresnelFloat): TCanvasError;
 
 var
   Ref: TCanvasReference;
@@ -1120,7 +1385,7 @@ Window.createImageBitmap(ImgData)._then(
   Result:=ECANVAS_SUCCESS;
 end;
 
-function TWasmFresnelApi.DrawImageEx(aID: TCanvasID; DrawData : TWasmPointer; aImageData: TWasmPointer): TCanvasError;
+function TWasmFresnelApi.DrawImageEx(aID: TCanvasID; DrawData: PFresnelFloat; aImageData: TWasmPointer): TCanvasError;
 
 var
   V : TJSDataView;
@@ -1284,8 +1549,7 @@ begin
   Result:=ECANVAS_SUCCESS;
 end;
 
-function TWasmFresnelApi.DrawPath(aID: TCanvasID; aFlags: Longint;
-  aPathCount: longint; aPath: TWasmPointer): TCanvasError;
+function TWasmFresnelApi.DrawPath(aID: TCanvasID; aFlags: Longint; aPathCount: longint; aPath: PFresnelFloat): TCanvasError;
 var
   Canv:TJSCanvasRenderingContext2D;
   P2D : TJSPath2D;
@@ -1363,8 +1627,8 @@ begin
   Result:=ECANVAS_SUCCESS;
 end;
 
-function TWasmFresnelApi.PointInPath(aID: TCanvasID; aX,aY: TFresnelFloat;
-  aPointCount: Integer; aPointData: TWasmPointer; aRes: TWasmPointer): TCanvasError;
+function TWasmFresnelApi.PointInPath(aID: TCanvasID; aX, aY: TFresnelFloat; aPointCount: Integer; aPointData: PFresnelFloat;
+  aRes: TWasmPointer): TCanvasError;
 var
   Canv:TJSCanvasRenderingContext2D;
   P2D : TJSPath2D;
@@ -1446,8 +1710,8 @@ function TWasmFresnelApi.SetTransform(aID: TCanvasID; Flags: Longint; m11, m12,
   m21, m22, m31, m32: TFresnelFloat): TCanvasError;
 
 var
-  Canv:TJSCanvasRenderingContext2D;
-
+  Ref : TCanvasReference;
+  DoReset : Boolean;
 begin
   {$IFNDEF NOLOGAPICALLS}
   If LogAPICalls then
@@ -1455,16 +1719,12 @@ begin
     LogCall('Canvas.SetTransform(%d,%d,[%g,%g,%g,%g,%g,%g])',[aID,Flags,m11,m12,m21,m22,m31,m32]);
     end;
   {$ENDIF}
-  Canv:=GetCanvas(aID);
-  if Not Assigned(Canv) then
+  Ref:=GetCanvasRef(aID);
+  if Not Assigned(Ref) then
     Exit(ECANVAS_NOCANVAS);
-  if (Flags and TRANSFORM_RESET)<>0 then
-    begin
-    canv.resetTransform();
-    canv.setTransform(m11,m12,m21,m22,m31,m32)
-    end
-  else
-    canv.transform(m11,m12,m21,m22,m31,m32);
+  DoReset:=(Flags and TRANSFORM_RESET)<>0;
+//  canv.setTransform(m11,m12,m21,m22,m31,m32)
+  Ref.SetTransform(m11,m12,m21,m22,m31,m32,DoReset);
   Result:=ECANVAS_SUCCESS;
 end;
 
@@ -1529,6 +1789,7 @@ begin
     if Not Assigned(Ref) then
       exit;
     Ref.title:=S;
+    Exit(ECANVAS_SUCCESS);
     end;
 end;
 
@@ -1581,7 +1842,8 @@ begin
   Ref:=GetCanvasRef(aID);
   if Not Assigned(Ref) then
     exit;
-  Ref.CanvasContext.Save;
+  Ref.SaveState;
+  Ref.FClipRects:=[];
   if (aFlags and STATE_FLAGS_RESTORE_PROPS)<>0 then
     Ref.ApplyProperties;
   Result:=ECANVAS_SUCCESS;
@@ -1603,13 +1865,11 @@ begin
   Ref:=GetCanvasRef(aID);
   if Not Assigned(Ref) then
     exit;
-  Ref.CanvasContext.Restore;
-  if (aFlags and STATE_FLAGS_RESTORE_PROPS)<>0 then
-    Ref.ApplyProperties;
+  Ref.RestoreState((aFlags and STATE_FLAGS_RESTORE_PROPS)<>0);
   Result:=ECANVAS_SUCCESS;
 end;
 
-Procedure TWasmFresnelApi.DrawClipRect(Ref : TCanvasReference; aX,aY,aWidth,aHeight: double);
+procedure TWasmFresnelApi.DrawClipRect(Ref: TCanvasReference; aX, aY, aWidth, aHeight: double);
 
 var
   col : jsvalue;
@@ -1619,7 +1879,7 @@ begin
   With Ref.canvascontext do
      begin
      col:=strokeStyle;
-     strokeStyle:='rgb(255 0 0)';
+     strokeStyle:='rgb(0 255 0)';
      lw:=linewidth;
      lineWidth:=1;
      strokeRect(aX-1,aY-1,aWidth+2,aHeight+2);
@@ -1633,7 +1893,7 @@ function TWasmFresnelApi.ClipAddRect(aID: TCanvasID; aX,aY,aWidth,aHeight: TFres
 
 var
   Ref : TCanvasReference;
-  P2D : TJSPath2D;
+  Rect : TClipRect;
 
 begin
   {$IFNDEF NOLOGAPICALLS}
@@ -1648,9 +1908,12 @@ begin
     exit;
   if daClipRect in DebugAPIs then
     DrawClipRect(Ref,aX,aY,aWidth,aHeight);
-  P2D:=TJSPath2D.New;
-  P2D.rect(aX,aY,aWidth,aHeight);
-  Ref.canvascontext.clip(P2D);
+  Rect.X:=aX;
+  Rect.Y:=aY;
+  Rect.W:=aWidth;
+  Rect.H:=aHeight;
+  Ref.AddClipRect(Rect);
+  Ref.SetClipPath;
   Result:=ECANVAS_SUCCESS;
 end;
 
@@ -1675,20 +1938,36 @@ var
     else
       Console.Error('No more tick callback !');
     if not Continue then
+      begin
+      {$IFNDEF NOLOGAPICALLS}
+      If LogAPICalls then
+        LogCall('FresnelAPi.TimerTick(%d), return value false, deactivate',[aTimerID]);
+      {$ENDIF}
       DeAllocateTimer(aTimerID);
+      end;
   end;
 
 begin
+  {$IFNDEF NOLOGAPICALLS}
+  If LogAPICalls then
+    LogCall('FresnelApi.AllocateTimer(%d,[%x])',[aInterval,UserData]);
+  {$ENDIF}
   Callback:=InstanceExports['__fresnel_timer_tick'];
   if Not Assigned(Callback) then
     Exit(0);
   aTimerID:=Window.setInterval(@HandleTimer,aInterval);
   Result:=aTimerID;
+  {$IFNDEF NOLOGAPICALLS}
+  If LogAPICalls then
+    LogCall('FresnelApi.AllocateTimer(%d,[%x] => %d)',[aInterval,UserData,Result]);
+  {$ENDIF}
 end;
 
 procedure TWasmFresnelApi.DeallocateTimer(timerid: TTimerID);
 begin
-  window.clearTimeout(TimerID);
+  If LogAPICalls then
+    LogCall('FresnelApi.DeAllocateTimer(%d)',[TimerID]);
+  window.clearInterval(TimerID);
 end;
 
 
@@ -1871,6 +2150,96 @@ begin
   Result:=EWASMEVENT_SUCCESS;
 end;
 
+function TWasmFresnelApi.HandleMenuClick(aMenuID: TMenuID; aData: TWasmPointer): Boolean;
+
+var
+  Callback : JSValue;
+
+begin
+  Result:=False;
+  if not assigned(InstanceExports) then
+    Console.warn('No instance exports !')
+  else
+    begin
+    Callback:=InstanceExports['__fresnel_menu_click'];
+    if Assigned(Callback) then
+      begin
+      TMenuClickCallback(CallBack)(aMenuID,AData);
+      Result:=True;
+      end
+    else
+      Console.warn('No menu click callback !');
+    end
+end;
+
+function TWasmFresnelApi.AddMenuItem(aCanvasID: TCanvasId; aParentID: TMenuID; aCaption: TWasmPointer; aCaptionLen: Longint;
+  aData: TWasmPointer; aFlags: Longint; aShortCut: Longint; aMenuID: PMenuID): TCanvasError;
+
+var
+  S : String;
+  Ref : TCanvasReference;
+  lMenuID : TMenuID;
+  el : TJSHTMLElement;
+  lFlags : TMenuFlags;
+
+begin
+  S:=Env.GetUTF8StringFromMem(aCaption,aCaptionLen);
+  {$IFNDEF NOLOGAPICALLS}
+  If LogAPICalls then
+    begin
+    LogCall('FresnelAPI.AddMenuItem(%d,"%s",%d,[%x],[%x])',[aCanvasID,S,aParentID,aData,aMenuID]);
+    end;
+  {$ENDIF}
+  if not MenuSupport then
+    Exit(ECANVAS_NOMENUSUPPORT);
+  Ref:=GetCanvasRef(aCanvasID);
+  if not assigned(Ref) then
+    Exit(ECANVAS_NOCANVAS);
+  if not Assigned(Ref.MenuBuilder)then
+    Exit(ECANVAS_NOMENUSUPPORT);
+  lMenuID:=TFresnelHelper.AllocateMenuID;
+  LFlags:=FlagsToMenuFlags(aFlags);
+  if Ref.MenuBuilder.AddMenuItem(aParentID,lMenuID,S,lFlags,aShortCut,aData)<>Nil then
+    begin
+    Env.SetMemInfoInt32(aMenuID,lMenuID);
+    El:=TJSHTMLELement(Document.GetElementByID('ffm'+IntToStr(aCanvasID)));
+    if assigned(el) then
+      el.style.removeProperty('display');
+    end;
+  Result:=ECANVAS_SUCCESS;
+end;
+
+function TWasmFresnelApi.DeleteMenuItem(aCanvasID: TCanvasId; aMenuID: TMenuID): TCanvasError;
+var
+  S : String;
+  Ref : TCanvasReference;
+  lMenuID : TMenuID;
+  el : TJSHTMLElement;
+  lFlags : TMenuFlags;
+
+begin
+  {$IFNDEF NOLOGAPICALLS}
+  If LogAPICalls then
+    begin
+    LogCall('FresnelAPI.AddMenuItem(%d,%d)',[aCanvasID,aMenuID]);
+    end;
+  {$ENDIF}
+  if not MenuSupport then
+    Exit(ECANVAS_NOMENUSUPPORT);
+  Ref:=GetCanvasRef(aCanvasID);
+  if not assigned(Ref) then
+    Exit(ECANVAS_NOCANVAS);
+  if not Assigned(Ref.MenuBuilder)then
+    Exit(ECANVAS_NOMENUSUPPORT);
+  Ref.MenuBuilder.RemoveMenuItem(aMenuID);
+  Result:=ECANVAS_SUCCESS;
+end;
+
+function TWasmFresnelApi.UpdateMenuItem(aCanvasID: TCanvasId; aMenuID: TMenuID; aFlags: Longint; aShortCut: Longint): TCanvasError;
+begin
+
+end;
+
 
 
 function TWasmFresnelApi.getcanvasbyid(aCanvasElementID: TWasmPointer; aElementIDLen: Longint; aID: TWasmPointer): TCanvasError;
@@ -1922,7 +2291,7 @@ end;
 function TWasmFresnelApi.allocatecanvas(SizeX, SizeY: Longint; aID: TWasmPointer): TCanvasError;
 
 Var
-  CTitle,CParent : TJSHTMLElement;
+  CMenu,CTitle,CParent : TJSHTMLElement;
   Canv : TJSHTMLCanvasElement;
   Ref : TCanvasReference;
   V : TJSDataView;
@@ -1945,6 +2314,14 @@ begin
   CTitle.id:='fft'+sID;
   CTitle.className:='fresnel-window-title';
   CParent.AppendChild(CTitle);
+  if MenuSupport then
+    begin
+    CMenu:=TJSHTMLElement(document.createElement('div'));
+    CMenu.id:='ffm'+sID;
+    CMenu.className:='fresnel-window-menu';
+    CMenu.style.setProperty('display','none');
+    CParent.AppendChild(CMenu);
+    end;
   Canv:=TJSHTMLCanvasElement(document.createElement('CANVAS'));
   Canv.id:='ffc'+sID;
   Canv.className:='fresnel-window-client';
@@ -1956,6 +2333,8 @@ begin
   Ref:=TCanvasReference.Create(aCanvasID,Self,Canv,CParent);
   Ref.WindowTitle:=CTitle;
   Ref.textBaseline:='top';
+  If MenuSupport then
+    Ref.MenuBuilder:=CreateMenuBuilder(CMenu);
 //  Writeln('Set Ref.textBaseline ',Ref.textBaseline,' to ',Ref.canvascontext.textBaseline);
   FCanvases[sID]:=Ref;
   v.setUint32(aID, aCanvasID, env.IsLittleEndian);

src/wasm/fresnel.wasm.api.pp

@@ -320,7 +320,6 @@ function __fresnel_canvas_clip_add_rect(
 ):  TCanvasError; external 'fresnel_api' name 'canvas_clip_add_rect';
 
 
-
 { ---------------------------------------------------------------------
   Timer API
   ---------------------------------------------------------------------}
@@ -360,6 +359,36 @@ Type
   TFresnelTimerTickEvent = Procedure (aTimerID : TTimerID; userdata : pointer; var aContinue : Boolean);
   TFresnelLogHook = procedure (const Msg : string) of object;
   TFresnelLogLevelHook = procedure (Level : TFresnelLogLevel; const Msg : string) of object;
+  TFresnelMenuClickEvent = procedure(aMenuID : TMenuID; aData : Pointer) of object;
+
+{ ---------------------------------------------------------------------
+  Menu API
+  ---------------------------------------------------------------------}
+
+
+function __fresnel_menu_add_item(
+  aID : TCanvasID;
+  aParent : TMenuID;
+  aCaption : PByte;
+  aCaptionLen : Longint;
+  aClickData : PByte;
+  aFlags : Longint;
+  aShortCut : Longint;
+  aMenuID : PMenuID
+) : TCanvasError; external 'fresnel_api' name 'menu_add_item';
+
+function __fresnel_menu_remove_item(
+  aID : TCanvasID;
+  aMenuID : TMenuID
+) : TCanvasError; external 'fresnel_api' name 'menu_remove_item';
+
+function __fresnel_menu_update_item(
+  aID : TCanvasID;
+  aMenuID : TMenuID;
+  aFlags : longint;
+  aShortCut : Longint
+) : TCanvasError; external 'fresnel_api' name 'menu_update_item';
+
 
 var
   OnFresnelWasmTick : TFresnelTickEvent;
@@ -367,12 +396,14 @@ var
   OnFresnelTimerTick : TFresnelTimerTickEvent;
   OnFresnelLog : TFresnelLogHook deprecated 'Use OnFresnelLogLevel';
   OnFresnelLogLevel : TFresnelLogLevelHook;
+  OnFresnelMenuClick : TFresnelMenuClickEvent;
 
 { Exported functions }
 
 procedure __fresnel_tick (aCurrent,aPrevious : double);
 procedure __fresnel_process_message (aCurrent,aPrevious : double);
 function __fresnel_timer_tick(timerid: TTimerID; userdata : pointer) : boolean;
+procedure __fresnel_menu_click(menuid: TMenuID; userdata : pointer);
 
 
 procedure __fresnel_log(aLevel : TFresnelLogLevel; Const Msg : string);
@@ -488,9 +519,18 @@ begin
     Result:=False;
 end;
 
+procedure __fresnel_menu_click(menuid: TMenuID; userdata : pointer);
+
+begin
+  if assigned(OnFresnelMenuClick) then
+    OnFresnelMenuClick(menuid,userdata)
+end;
+
+
 exports
   __fresnel_process_message,
   __fresnel_timer_tick,
+  __fresnel_menu_click,
   __fresnel_tick;
 
 end.

src/wasm/fresnel.wasm.shared.pp

@@ -50,6 +50,8 @@ Type
   TCanvasLineJoin = byte;
   TCanvasTextBaseLine = Byte;
   TCanvasLineMiterLimit = TFresnelFloat;
+  TMenuID = longint;
+
 
   TCanvasMessageID = longint;
   TCanvasMessageParam = longint;
@@ -95,6 +97,7 @@ Type
   PLineDashPatternData = ^TLineDashPattern;
   PKeyMap = PLongint;
   TWasmPointer = Pointer;
+  PMenuID = ^TMenuID;
   {$ELSE}
   TWasmPointer = Longint;
   PFresnelFloat = TWasmPointer;
@@ -107,6 +110,7 @@ Type
   PGradientColorPoints = TWasmPointer;
   PLineDashPatternData = TWasmPointer;
   PKeyMap = TWasmPointer;
+  PMenuID = TWasmPointer;
   {$ENDIF}
 
 Const
@@ -114,6 +118,7 @@ Const
   ECANVAS_NOCANVAS     = 1;
   ECANVAS_INVALIDPATH  = 2;
   ECANVAS_INVALIDPARAM = 3;
+  ECANVAS_NOMENUSUPPORT = 4;
   ECANVAS_UNSPECIFIED  = -1;
 
   CANVAS_LINECAP_BUTT   = 0;
@@ -246,6 +251,11 @@ Const
   // Save/Restore
   STATE_FLAGS_RESTORE_PROPS = 1;
 
+  // Menu flags
+  MENU_FLAGS_INVISIBLE = 1;
+  MENU_FLAGS_CHECKED = 2;
+  MENU_FLAGS_RADIO   = 4;
+
 Function LineCapToString(aCap: TCanvasLineCap) : String;
 Function LineJoinToString(aJoin: TCanvasLineJoin) : String;
 Function TextBaseLineToString(aBaseLine : TCanvasTextBaseLine) : String;