Ver código fonte

+ Add menu support (not yet used in Fresnel)

Michael Van Canneyt 11 meses atrás
pai
commit
aa12a84fc3
2 arquivos alterados com 327 adições e 29 exclusões
  1. 317 29
      src/pas2js/fresnel.pas2js.wasmapi.pp
  2. 10 0
      src/wasm/fresnel.wasm.shared.pp

+ 317 - 29
src/pas2js/fresnel.pas2js.wasmapi.pp

@@ -1,18 +1,3 @@
-{
-    This file is part of the Fresnel Library.
-    Copyright (c) 2024 by the FPC & Lazarus teams.
-
-    Class to expose HTML canvas and mouse events to a Webassembly module.
-
-    See the file COPYING.modifiedLGPL.txt, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
 {$mode objfpc}
 {$h+}
 {$modeswitch externalclass}
@@ -49,13 +34,16 @@ Type
 
   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 }
@@ -71,6 +59,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);
 
@@ -104,6 +123,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;
@@ -116,13 +136,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
@@ -137,13 +163,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
@@ -152,6 +176,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;
@@ -201,6 +229,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;
@@ -228,6 +261,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;
@@ -236,6 +270,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 }
@@ -294,7 +344,7 @@ begin
     end;
 end;
 
-class Function TFresnelHelper.ShiftStateToInt(aState : TShiftState) : Integer;
+class function TFresnelHelper.ShiftStateToInt(aState: TShiftState): Integer;
 
 var
   S : TShiftStateEnum;
@@ -637,6 +687,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);
 
@@ -708,12 +868,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);
@@ -819,6 +990,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;
@@ -893,7 +1067,7 @@ begin
 
 end;
 
-function TWasmFresnelApi.GetCanvasSizes(aID: TCanvasID; aWidth, aHeight: TWasmPointer): TCanvasError;
+function TWasmFresnelApi.GetCanvasSizes(aID: TCanvasID; aWidth, aHeight: PFresnelFloat): TCanvasError;
 
 var
   Ref: TCanvasReference;
@@ -1135,7 +1309,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;
@@ -1299,8 +1473,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;
@@ -1378,8 +1551,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;
@@ -1544,6 +1717,7 @@ begin
     if Not Assigned(Ref) then
       exit;
     Ref.title:=S;
+    Exit(ECANVAS_SUCCESS);
     end;
 end;
 
@@ -1624,7 +1798,7 @@ begin
   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;
@@ -1684,26 +1858,40 @@ var
   begin
     // The instance/timer could have disappeared
     Callback:=InstanceExports['__fresnel_timer_tick'];
+    Writeln(Format('FresnelAPi.TimerTick(%d)',[aTimerID]));
     Continue:=Assigned(Callback);
     if Continue then
       Continue:=TTimerTickCallback(CallBack)(aTimerID,userData)
     else
       Console.Error('No more tick callback !');
     if not Continue then
+      begin
+      Writeln(Format('FresnelAPi.TimerTick(%d), return value false, deactivate',[aTimerID]));
       DeAllocateTimer(aTimerID);
+      end;
   end;
 
 begin
+  Writeln(Format('FresnelApi.AllocateTimer(%d,[%x])',[aInterval,UserData]));
+  If LogAPICalls then
+    begin
+    LogCall('FresnelApi.AllocateTimer(%d,[%x])',[aInterval,UserData]);
+    end;
   Callback:=InstanceExports['__fresnel_timer_tick'];
   if Not Assigned(Callback) then
     Exit(0);
   aTimerID:=Window.setInterval(@HandleTimer,aInterval);
   Result:=aTimerID;
+  LogCall('FresnelApi.AllocateTimer(%d,[%x] => %d)',[aInterval,UserData,Result]);
+//  Writeln(Format('FresnelAPi.AllocateTimer(%d,[%x]) => %d',[aInterval,UserData,Result]));
 end;
 
 procedure TWasmFresnelApi.DeallocateTimer(timerid: TTimerID);
 begin
-  window.clearTimeout(TimerID);
+  If LogAPICalls then
+    LogCall('FresnelApi.DeAllocateTimer(%d)',[TimerID]);
+  Writeln(Format('FresnelApi.DeAllocateTimer(%d)',[TimerID]));
+  window.clearInterval(TimerID);
 end;
 
 
@@ -1886,6 +2074,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;
@@ -1937,7 +2215,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;
@@ -1960,6 +2238,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';
@@ -1971,6 +2257,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);

+ 10 - 0
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;