Procházet zdrojové kódy

* Add webassembly message channel api

Michaël Van Canneyt před 2 týdny
rodič
revize
eac5353bf5

+ 65 - 0
packages/wasm-utils/demo/messagechannel/channeldemo.lpi

@@ -0,0 +1,65 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="channeldemo"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="channeldemo.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="channeldemo.wasm" ApplyConventions="False"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Subtarget Value="browser"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <ExecutableType Value="Library"/>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 52 - 0
packages/wasm-utils/demo/messagechannel/channeldemo.lpr

@@ -0,0 +1,52 @@
+library channeldemo;
+
+uses sysutils, wasm.messagechannel.objects;
+
+Type
+
+  { TApp }
+
+  TApp = Class(TObject)
+    FChannel : TWasmMessageChannel;
+    FCounter : Integer;
+    procedure SendMessage;
+    constructor create;
+  end;
+
+var
+  App : TApp;
+
+procedure SendMessage;
+
+begin
+  App.SendMessage;
+end;
+
+exports SendMessage;
+
+{ TApp }
+
+procedure HandleMessage(Sender: TObject; const aMessage: string);
+begin
+  Writeln('WASM received on "some_channel" a message: ',aMessage);
+end;
+
+procedure TApp.SendMessage;
+var
+  S : string;
+begin
+  inc(FCounter);
+  S:=Format('This is message #%d.',[FCounter]);
+  FChannel.SendMessage(S,False);
+end;
+
+constructor TApp.create;
+begin
+  FChannel:=TWasmBroadcastMessageChannel.Create('some_channel');
+  FChannel.OnMessage:=@HandleMessage;
+end;
+
+begin
+  App:=TApp.Create;
+end.
+

+ 10 - 0
packages/wasm-utils/fpmake.pp

@@ -49,6 +49,16 @@ begin
       T.Dependencies.AddUnit('wasm.http.api');
       T.Dependencies.AddUnit('wasm.http.api');
       T.Dependencies.AddUnit('wasm.http.shared');
       T.Dependencies.AddUnit('wasm.http.shared');
 
 
+    // Messsage channel
+    T:=P.Targets.AddUnit('wasm.messagechannel.shared.pas');
+
+    T:=P.Targets.AddUnit('wasm.messagechannel.api.pas');
+      T.Dependencies.AddUnit('wasm.messagechannel.shared');
+      
+    T:=P.Targets.AddUnit('wasm.messagechannel.objects.pas');
+      T.Dependencies.AddUnit('wasm.messagechannel.api');
+      T.Dependencies.AddUnit('wasm.messagechannel.shared');
+
     // Websocket
     // Websocket
     T:=P.Targets.AddUnit('wasm.websocket.shared.pas');
     T:=P.Targets.AddUnit('wasm.websocket.shared.pas');
     
     

+ 111 - 0
packages/wasm-utils/src/wasm.messagechannel.api.pas

@@ -0,0 +1,111 @@
+{
+    This file is part of the Free Component Library
+
+    Webassembly MessageChannel API - low-level interface.
+    Copyright (c) 2025 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, 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.
+
+ **********************************************************************}
+unit wasm.messagechannel.api;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  wasm.messagechannel.shared;
+
+
+function __msgchannel_send_message_utf8(
+  aID: TWasmMessageChannelID;
+  aData: PByte;
+  aDataLen: Longint;
+  aDeserialize: Longint
+  ): TWasmMessageChannelResult; external MsgChannelExportName name MsgChannelFN_SendUTF8;
+
+function __msgchannel_send_message_utf16(
+  aID: TWasmMessageChannelID;
+  aData: PUnicodeChar;
+  aDataCharLen: Longint;
+  aDeserialize: Longint
+  ): TWasmMessageChannelResult; external MsgChannelExportName name MsgChannelFN_SendUTF16;
+
+function __msgchannel_allocate(
+  aID: TWasmMessageChannelID;
+  aType: Longint;
+  aName: PAnsiChar;
+  aNameLen: Longint
+  ): TWasmMessageChannelResult; external MsgChannelExportName name MsgChannelFN_Allocate;
+
+function __msgchannel_deallocate(
+  aID: TWasmMessageChannelID
+  ): TWasmMessageChannelResult; external MsgChannelExportName name MsgChannelFN_DeAllocate;
+
+function __msgchannel_listen(
+  aID: TWasmMessageChannelID;
+  aUseUTF16 : boolean
+  ): TWasmMessageChannelResult; external MsgChannelExportName name MsgChannelFN_Listen;
+
+Type
+  TWasmOnUTF8MessageCallBack = procedure(aID : TWasmMessageChannelID; S : AnsiString) of object;
+  TWasmOnUTF16MessageCallBack = procedure(aID : TWasmMessageChannelID; S : UnicodeString) of object;
+
+var
+  OnMessageUTF8 : TWasmOnUTF8MessageCallBack;
+  OnMessageUTF16 : TWasmOnUTF16MessageCallBack;
+
+procedure messagechannel_onmesssage_callback_utf8(
+  aID : TWasmMessageChannelID;
+  aMsg : PAnsiChar;
+  aMsgLen : Longint);
+
+procedure messagechannel_onmesssage_callback_utf16(
+  aID : TWasmMessageChannelID;
+  aMsg : PUnicodeChar;
+  aMsgLen : Longint);
+
+
+implementation
+
+
+procedure messagechannel_onmesssage_callback_utf8(aID: TWasmMessageChannelID; aMsg: PAnsiChar; aMsgLen: Longint);
+
+var
+  S : UTF8String;
+
+begin
+  if assigned(OnMessageUTF8) then
+    begin
+    SetLength(S,aMsgLen);
+    if aMsgLen>0 then
+      Move(aMsg^,S[1],aMsgLen);
+    OnMessageUTF8(aID,S);
+    end;
+end;
+
+procedure messagechannel_onmesssage_callback_utf16(aID: TWasmMessageChannelID; aMsg: PUnicodeChar; aMsgLen: Longint);
+
+var
+  S : UTF8String;
+
+begin
+  if assigned(OnMessageUTF16) then
+    begin
+    SetLength(S,aMsgLen);
+    if aMsgLen>0 then
+      Move(aMsg^,S[1],aMsgLen);
+    OnMessageUTF8(aID,S);
+    end;
+end;
+
+exports
+  messagechannel_onmesssage_callback_utf8, messagechannel_onmesssage_callback_utf16;
+
+end.
+

+ 241 - 0
packages/wasm-utils/src/wasm.messagechannel.objects.pas

@@ -0,0 +1,241 @@
+{
+    This file is part of the Free Component Library
+
+    Webassembly MessageChannel API - object interface.
+    Copyright (c) 2025 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, 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.
+
+ **********************************************************************}
+
+unit wasm.messagechannel.objects;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.SysUtils,
+  System.Classes,
+  {$ELSE}
+  sysutils,
+  classes,
+  {$endif}
+  wasm.messagechannel.shared, wasm.messagechannel.api;
+
+Type
+  EMessageChannel = class(Exception);
+  TMessageChannelEvent = procedure(Sender : TObject; const aMessage : string);
+
+  { TWasmMessageChannel }
+
+  TWasmMessageChannel = Class (TObject)
+  private
+    FID : TWasmMessageChannelID;
+    FOnMessage: TMessageChannelEvent;
+    procedure SetOnMessage(AValue: TMessageChannelEvent);
+  Public
+    constructor create(aType : TWasmMessageChannelType);
+    destructor destroy; override;
+    Procedure SendMessage(const S : String; aDeserialize : boolean);
+    Property ID : TWasmMessageChannelID read FID;
+    Property OnMessage : TMessageChannelEvent Read FOnMessage Write SetOnMessage;
+  end;
+
+  { TWasmBroadcastMessageChannel }
+
+  TWasmBroadcastMessageChannel = class(TWasmMessageChannel)
+  public
+    constructor Create(const aName : UTF8String); reintroduce;
+  end;
+
+  { TWasmWorkerMessageChannel }
+
+  TWasmWorkerMessageChannel = class(TWasmMessageChannel)
+  public
+    constructor Create(); reintroduce;
+  end;
+
+  { TMessageChannelController }
+
+  TMessageChannelController = class sealed (TObject)
+  private
+    class var _Instance: TMessageChannelController;
+  private
+    FCurrentID : TWasmMessageChannelID;
+    FList : TThreadList;
+  protected
+    function getNextID : TWasmMessageChannelID;
+    function FindChannel(aID: TWasmMessageChannelID): TWasmMessageChannel;
+    procedure HandleMessage(aID: TWasmMessageChannelID; S: String);
+    procedure Register(aChannel : TWasmMessageChannel);
+    procedure UnRegister(aChannel : TWasmMessageChannel);
+  Public
+    constructor create;
+    destructor destroy;
+    class constructor init;
+    class destructor done;
+    class property Instance : TMessageChannelController read _Instance;
+  end;
+
+implementation
+
+uses wasm.logger.api;
+
+{ TWasmMessageChannel }
+
+procedure TWasmMessageChannel.SetOnMessage(AValue: TMessageChannelEvent);
+const
+  {$if SizeOf(Char)=2}
+  UseUTF16 = True;
+  {$ELSE}
+  UseUTF16 = False;
+  {$ENDIF}
+begin
+  if FOnMessage=AValue then Exit;
+  FOnMessage:=AValue;
+  __msgchannel_listen(ID,UseUTF16);
+end;
+
+constructor TWasmMessageChannel.create(aType: TWasmMessageChannelType);
+begin
+  FID:=TMessageChannelController.Instance.getNextID;
+end;
+
+destructor TWasmMessageChannel.destroy;
+var
+  lRes : TWasmMessageChannelResult;
+begin
+  lRes:=__msgchannel_deallocate(ID);
+  if lRes<>WASMMSGCHANNEL_RESULT_SUCCESS then
+    __wasm_log(wllError,className,'Failed to deallocate message %d. Error: %d',[Id,lRes]);
+  TMessageChannelController.Instance.UnRegister(Self);
+  Inherited destroy;
+end;
+
+procedure TWasmMessageChannel.SendMessage(const S: String; aDeserialize : boolean);
+var
+  lRes : TWasmMessageChannelResult;
+begin
+  {$if SizeOf(Char)=2}
+  lRes:=__msgchannel_send_message_UTF16(ID,PUnicodeChar(S),Length(S),Ord(aDeserialize));
+  {$ELSE}
+  lRes:=__msgchannel_send_message_UTF8(ID,PByte(S),Length(S),Ord(aDeserialize));
+  {$ENDIF}
+  if lRes<>WASMMSGCHANNEL_RESULT_SUCCESS then
+    Raise EMessageChannel.CreateFmt('Failed to send message on channel %d. Error: %d',[Id,lRes]);
+end;
+
+{ TWasmBroadcastMessageChannel }
+
+constructor TWasmBroadcastMessageChannel.Create(const aName: UTF8String);
+var
+  lRes : TWasmMessageChannelResult;
+begin
+  inherited create(ctBroadcast);
+  lRes:=__msgchannel_allocate(FID,Ord(ctBroadcast),PAnsiChar(aName),Length(aName));
+  if lRes<>WASMMSGCHANNEL_RESULT_SUCCESS then
+    Raise EMessageChannel.CreateFmt('Failed to create message channel. Error: %d',[lRes]);
+  TMessageChannelController.Instance.Register(Self);
+end;
+
+{ TWasmWorkerMessageChannel }
+
+constructor TWasmWorkerMessageChannel.Create();
+var
+  lRes : TWasmMessageChannelResult;
+begin
+  inherited create(ctWorker);
+  lRes:=__msgchannel_allocate(FID,Ord(ctWorker),Nil,0);
+  if lRes<>WASMMSGCHANNEL_RESULT_SUCCESS then
+    Raise EMessageChannel.CreateFmt('Failed to create message channel. Error: %d',[lRes]);
+  TMessageChannelController.Instance.Register(Self);
+end;
+
+{ TMessageChannelController }
+
+function TMessageChannelController.getNextID: TWasmMessageChannelID;
+begin
+  Result:=InterlockedIncrement(FCurrentID);
+end;
+
+procedure TMessageChannelController.Register(aChannel: TWasmMessageChannel);
+begin
+  FList.Add(aChannel);
+end;
+
+procedure TMessageChannelController.UnRegister(aChannel: TWasmMessageChannel);
+begin
+  FList.Remove(aChannel);
+end;
+
+function TMessageChannelController.FindChannel(aID : TWasmMessageChannelID) : TWasmMessageChannel;
+
+var
+  l : TList;
+  i : Integer;
+
+begin
+  Result:=nil;
+  L:=FList.LockList;
+  try
+    I:=0;
+    While (Result=Nil) and (I<L.Count) do
+      begin
+      Result:=TWasmMessageChannel(l[i]);
+      if Result.ID<>aID then
+        Result:=Nil;
+      Inc(i);
+      end;
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+
+
+procedure TMessageChannelController.HandleMessage(aID : TWasmMessageChannelID; S : String);
+var
+  lChannel : TWasmMessageChannel;
+begin
+  lChannel:=FindChannel(aID);
+  if Assigned(lChannel) and Assigned(lChannel.OnMessage) then
+    lChannel.OnMessage(lChannel,S);
+end;
+
+//procedure TMessageChannelController.
+
+constructor TMessageChannelController.create;
+begin
+  FCurrentID:=0;
+  FList:=TThreadList.Create;
+{$IF SizeOf(char)=1}
+  OnMessageUTF8:=@HandleMessage;
+{$ELSE}
+  OnMessageUTF16:=@HandleMessage;
+{$ENDIF}
+end;
+
+destructor TMessageChannelController.destroy;
+begin
+  FreeAndNil(Flist);
+end;
+
+class constructor TMessageChannelController.init;
+begin
+  _instance:=TMessageChannelController.Create;
+end;
+
+class destructor TMessageChannelController.done;
+begin
+  FreeAndNil(_instance);
+end;
+
+end.
+

+ 44 - 0
packages/wasm-utils/src/wasm.messagechannel.shared.pas

@@ -0,0 +1,44 @@
+{
+    This file is part of the Free Component Library
+
+    Webassembly MessageChannel API - shared parts with pas2js
+    Copyright (c) 2025 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, 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.
+
+ **********************************************************************}
+unit wasm.messagechannel.shared;
+
+interface
+type
+  TWasmMessageChannelResult = longint;
+  TWasmMessageChannelID = longint;
+  TWasmMessageChannelType = (ctWorker,ctBroadcast);
+
+
+const
+  WASMMSGCHANNEL_RESULT_SUCCESS         = 0;
+  WASMMSGCHANNEL_RESULT_INVALIDCHANNEL  = -1;
+  WASMMSGCHANNEL_RESULT_INVALIDDATALEN  = -2;
+  WASMMSGCHANNEL_RESULT_INVALIDTYPE     = -3;
+  WASMMSGCHANNEL_RESULT_UNSUPPORTEDTYPE = -4;
+
+
+const
+  MsgChannelExportName  = 'messagechannel';
+  MsgChannelFN_Allocate = 'messagechannel_allocate';
+  MsgChannelFN_DeAllocate = 'messagechannel_deallocate';
+  MsgChannelFN_SendUTF8 = 'messagechannel_send_utf8';
+  MsgChannelFN_SendUTF16 = 'messagechannel_send_utf16';
+  MsgChannelFN_Listen = 'messagechannel_listen';
+  MsgChannelFN_OnMessageUTF8 = 'messagechannel_onmesssage_callback_utf8';
+  MsgChannelFN_OnMessageUTF16 = 'messagechannel_onmesssage_callback_utf16';
+
+implementation
+
+end.