lazarus.fresnel/src/pas2js/fresnel.worker.pas2js.wasmapi.pp

{
    This file is part of the Fresnel Library.
    Copyright (c) 2025 by the FPC & Lazarus teams.

    Pas2js Fresnel interface - Webassembly rendering API

    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.

 **********************************************************************}

// hic sunt dracones

{$mode objfpc}
{$h+}
{$modeswitch externalclass}
{$modeswitch advancedrecords}

{$DEFINE IMAGE_USEOSC}

unit fresnel.worker.pas2js.wasmapi;

interface

uses
  SysUtils, Types,
  JS, WebOrWorker, WebWorker, wasienv,
  Rtl.WorkerCommands,
  fresnel.wasm.shared,
  fresnel.messages.pas2js.wasmapi,
  fresnel.menubuilder.pas2js.wasmapi,
  fresnel.shared.pas2js;

type

  TMainThreadCallFunc = reference to function: TCanvasError;

  TTimerCallback = procedure (aCurrentTicks, aPreviousTicks : NativeInt);

  { TWasmFresnelWorkerApi }

  TWasmFresnelWorkerApi = class(TWasmFresnelSharedApi)
  private
    FMenuSupport : Boolean;

    FAtomicBuffer : TJSSharedArrayBuffer;
    FAtomicArray : TJSInt32Array;

    class var vLastPendingCallID : NativeInt;

    // temporary to ignore some non-essential API calls
    function CreateIgnoreCall(const aFuncName: String): TMainThreadCallFunc;

    function CreateMainThreadBlockingCall(const aFuncName: String) : TMainThreadCallFunc;
    function CreateMainThreadFireAndForgetCall(const aFuncName: String) : TMainThreadCallFunc;

    procedure DeclareMainThreadBlockingCall(aImportObject : TJSObject; const aFuncName: String);
    procedure DeclareMainThreadFireAndForgetCall(aImportObject : TJSObject; const aFuncName: String);
    procedure DeclareMainThreadCall(aImportObject : TJSObject; const aFuncName: String);

    function DrawOffscreenCanvasOnWindowCanvas(const aWindowID : TWindowCanvasID; const aCanvasID : TOffscreenCanvasID) : TCanvasError;

    procedure DoTimerTick;


  protected
    procedure SetMenuSupport(const val : Boolean);

    procedure SetupLocalStorageBridge;

  public
    constructor Create(aEnv : TPas2JSWASIEnvironment); override;

    procedure HandleFresnelCommand(Cmd: TFresnelMessage);

    procedure FillImportObject(aObject : TJSObject); override;

    property MenuSupport : Boolean read FMenuSupport write SetMenuSupport;

    // Menu

    function HandleMenuClick(aMenuID : TMenuID; aData : TWasmPointer) : Boolean; override;

    // RequestAnimationFrame

    procedure RequestAnimationFrame(userData: TWasmPointer);
    procedure DoHandleAnimationFrameMessage(aMessage : TFresnelMessage_RequestAnimationFrame);

    // UserMedia

    procedure EnumerateUserMedia(userData: TWasmPointer);
    procedure DoHandleEnumeratedUserMediaMessage(aMessage : TFresnelMessage_EnumerateUserMedia);
    procedure DoHandleUserMediaFrame(aMessage : TFresnelMessage_UserMediaFrame);

  end;

// --------------------------------------------------------------------
// --------------------------------------------------------------------
// --------------------------------------------------------------------
implementation
// --------------------------------------------------------------------
// --------------------------------------------------------------------
// --------------------------------------------------------------------

{ TWasmFresnelWorkerApi }

// Create
//
constructor TWasmFresnelWorkerApi.Create(aEnv: TPas2JSWASIEnvironment);
begin
  inherited Create(aEnv);

  FAtomicBuffer := TJSSharedArrayBuffer.new(8);
  FAtomicArray := TJSInt32Array.new(FAtomicBuffer);
  TCommandDispatcher.Instance.specialize AddCommandHandler<TFresnelMessage>(cmdFresnel,@HandleFresnelCommand);
  SetupLocalStorageBridge;
end;

// CreateIgnoreCall
//
function TWasmFresnelWorkerApi.CreateIgnoreCall(const aFuncName: String): TMainThreadCallFunc;
begin
  Result := function () : TCanvasError
  begin
    writeln('Call ignored: ', aFuncName);
  end;
end;

// CreateMainThreadBlockingCall
//
function Array_prototype_slice(val : JSValue) : TJSValueDynArray; external name 'Array.prototype.slice.call';

function TWasmFresnelWorkerApi.CreateMainThreadBlockingCall(const aFuncName: String): TMainThreadCallFunc;
begin
  Result := function () : TCanvasError
  var
    pendingCallID : Integer;
    lMessage : TFresnelMessage_FunctionCall;
    atomicWaitOutcome : String;
  begin
    Inc(vLastPendingCallID);
    pendingCallID := vLastPendingCallID;

    lMessage := TFresnelMessage_FunctionCall.new;
    lMessage.Typ := cFresnel_Message_Call;
    lMessage.ID := pendingCallID;
    lMessage.FuncName := aFuncName;
    lMessage.Args := Array_prototype_slice(JSArguments);
    lMessage.Memory := Env.Memory.buffer;
    lMessage.Atomic := FAtomicArray;

    TJSAtomics.store(FAtomicArray, 0, 0);

    TJSDedicatedWorkerGlobalScope(Self_).postMessage(lMessage);

    atomicWaitOutcome := TJSAtomics.wait(FAtomicArray, 0, 0);
    //Console.log('Atomics wait for pendingCallID ', pendingCallID, '  = ', atomicWaitOutcome);

    Result := TJSAtomics.load(FAtomicArray, 1);
  end;
end;

// CreateMainThreadFireAndForgetCall
//
function TWasmFresnelWorkerApi.CreateMainThreadFireAndForgetCall(const aFuncName: String): TMainThreadCallFunc;
begin
  Result := function () : TCanvasError
  var
    pendingCallID : Integer;
    lMessage : TFresnelMessage_FunctionCall;
  begin
    Inc(vLastPendingCallID);
    pendingCallID := vLastPendingCallID;

    lMessage := TFresnelMessage_FunctionCall.new;
    lMessage.Typ := cFresnel_Message_Call;
    lMessage.ID := pendingCallID;
    lMessage.FuncName := aFuncName;
    lMessage.Args := Array_prototype_slice(JSArguments);

    TJSDedicatedWorkerGlobalScope(Self_).postMessage(lMessage);

    Result := ECANVAS_SUCCESS;
  end;
end;

// DeclareMainThreadBlockingCall
//
procedure TWasmFresnelWorkerApi.DeclareMainThreadBlockingCall(aImportObject: TJSObject; const aFuncName: String);
begin
  aImportObject[aFuncName] := CreateMainThreadBlockingCall(aFuncName);
end;

// DeclareMainThreadFireAndForgetCall
//
procedure TWasmFresnelWorkerApi.DeclareMainThreadFireAndForgetCall(aImportObject: TJSObject; const aFuncName: String);
begin
  aImportObject[aFuncName] := CreateMainThreadFireAndForgetCall(aFuncName);
end;

// DeclareMainThreadCall
//
procedure TWasmFresnelWorkerApi.DeclareMainThreadCall(aImportObject: TJSObject; const aFuncName: String);
begin
  DeclareMainThreadBlockingCall(aImportObject, aFuncName);
end;

// HandleFresnelCommand
//
procedure TWasmFresnelWorkerApi.HandleFresnelCommand(Cmd : TFresnelMessage);
var
  dataType: String;
begin
  dataType := cmd.Typ;
  Case dataType of
  cFresnel_RequestAnimationFrame:
    DoHandleAnimationFrameMessage(TFresnelMessage_RequestAnimationFrame(cmd));
  cFresnel_EnqueueEvent:
    EnqueueEvent(TWindowEvent(TFresnelMessage_EnqueueEvent(cmd).Event));
  cFresnel_Tick:
    DoTimerTick;
  cFresnel_Message_Call:
    begin
    if (cmd['funcName'] = 'wake_main_thread') then
      MainThreadWake;
    end;
  cFresnel_UserMediaFrame:
    DoHandleUserMediaFrame(TFresnelMessage_UserMediaFrame(cmd));
  cFresnel_MenuClick:
    HandleMenuClick(
      TFresnelMessage_HandleMenuClick(cmd).MenuID,
      TFresnelMessage_HandleMenuClick(cmd).UserData
    );
  cFresnel_EnumerateUserMedia:
    DoHandleEnumeratedUserMediaMessage(TFresnelMessage_EnumerateUserMedia(cmd));
  else
    writeln('Unsupported Fresnel message type ', TJSJSON.stringify(cmd));
  end;
end;

// RequestAnimationFrame
//
procedure TWasmFresnelWorkerApi.RequestAnimationFrame(userData: TWasmPointer);
var
  lMessage: TFresnelMessage_RequestAnimationFrame;
begin
  lMessage := TFresnelMessage_RequestAnimationFrame(TFresnelMessage.newMessage(cFresnel_RequestAnimationFrame));
  lMessage.UserData := userData;
  TCommandDispatcher.Instance.SendCommand(lMessage);
end;

// DoHandleAnimationFrameMessage
//
procedure TWasmFresnelWorkerApi.DoHandleAnimationFrameMessage(aMessage : TFresnelMessage_RequestAnimationFrame);
var
  lCallbackValue : JSValue;
  lCallback : TAnimationFrameCallback absolute lCallbackValue;
begin
  lCallbackValue := InstanceExports['__fresnel_animation_frame'];
  if lCallbackValue then
    lCallback;
end;

// EnumerateUserMedia
//
procedure TWasmFresnelWorkerApi.EnumerateUserMedia(userData: TWasmPointer);
var
  lMessage: TFresnelMessage_EnumerateUserMedia;
begin
  lMessage := TFresnelMessage_EnumerateUserMedia(TFresnelMessage.NewMessage(cFresnel_EnumerateUserMedia));
  lMessage.UserData := userData;
  TCommandDispatcher.Instance.SendCommand(lMessage);
end;

// DoHandleEnumeratedUserMediaMessage
//
procedure TWasmFresnelWorkerApi.DoHandleEnumeratedUserMediaMessage(aMessage: TFresnelMessage_EnumerateUserMedia);
var
  lCallback : JSValue;
begin
  FEnumeratedUserMedia := aMessage.UserMediaData;

  lCallback := InstanceExports['__fresnel_usermedia_enumerated'];
  if lCallback then
    TUserMediaCallback(lCallback)(Length(FEnumeratedUserMedia), aMessage.UserData);
end;

// DoHandleUserMediaFrame
//
procedure TWasmFresnelWorkerApi.DoHandleUserMediaFrame(aMessage: TFresnelMessage_UserMediaFrame);
var
  lBitmapID : Integer;
  lCallback : JSValue;
begin
  lCallback := InstanceExports['__fresnel_usermedia_frame'];
  if lCallback then
  begin
    lBitmapID := StoreImageBitmap(aMessage.ImageBitmap);
    TUserMediaFrameCallback(lCallback)(aMessage.Timestamp, aMessage.VideoID, lBitmapID);
  end
  else aMessage.ImageBitmap.close;
end;

// DrawOffscreenCanvasOnWindowCanvas
//
function TWasmFresnelWorkerApi.DrawOffscreenCanvasOnWindowCanvas(
 const aWindowID: TWindowCanvasID; const aCanvasID: TOffscreenCanvasID) : TCanvasError;
var
  lMessage : TFresnelMessage_DrawOffscreenCanvasOnWindow;
  pendingCallID : Integer;
  canvasRef : TOffscreenCanvasReference;
  canvas : TJSHTMLOffscreenCanvas;
begin
  Inc(vLastPendingCallID);
  pendingCallID := vLastPendingCallID;

  canvasRef := GetOffscreenCanvasRef(aCanvasID);
  if canvasRef = nil then
    Exit(ECANVAS_NOCANVAS);

  canvas := canvasRef.Canvas;

  if (canvas.Width = 0) or (canvas.Height = 0) then
    Exit(ECANVAS_SUCCESS);

  lMessage := TFresnelMessage_DrawOffscreenCanvasOnWindow(TFresnelMessage.NewMessage(cFresnel_Message_DOCOW));
  lMessage.ID := pendingCallID;
  lMessage.Atomic := FAtomicArray;
  lMessage.WindowID := aWindowID;
  lMessage.ImageBitmap := canvas.transferToImageBitmap;

  TJSAtomics.store(FAtomicArray, 0, 0);

  TCommandDispatcher.Instance.SendCommand(lMessage, [ lMessage.ImageBitmap ]);

  TJSAtomics.wait(FAtomicArray, 0, 0);

  Result := TJSAtomics.load(FAtomicArray, 1);
end;

// DoTimerTick
//
var
  vLastTimeTimerTick : NativeInt;
procedure TWasmFresnelWorkerApi.DoTimerTick;
var
  Callback : JSValue;
  T : NativeInt;
begin
  T := vLastTimeTimerTick;
  vLastTimeTimerTick := TJSDate.now;
  if not assigned(InstanceExports) then
    Console.log('DoTimerTick: no instance exports !')
  else
  begin
    Callback := InstanceExports['__fresnel_tick'];
    if Assigned(Callback) then
      TTimerCallback(CallBack)(vLastTimeTimerTick, T)
    else
      Console.warn('DoTimerTick: no tick callback !');
  end;
end;


// SetMenuSupport
//
procedure TWasmFresnelWorkerApi.SetMenuSupport(const val: Boolean);
var
  lMessage : TFresnelMessage;
begin
  if val = FMenuSupport then
    Exit;

  FMenuSupport := val;
  lMessage := TFresnelMessages.CreateMessage_MenuSupport(val);
  TCommandDispatcher.Instance.SendCommand(lMessage);
end;

// SetupLocalStorageBridge
//
procedure TWasmFresnelWorkerApi.SetupLocalStorageBridge;

type
  TGetItemMainThread = reference to function (aName : String; aDataBuffer : TJSSharedArrayBuffer) : TCanvasError;

var
  setItem, getItem, removeItem, clear : TMainThreadCallFunc;
  getItemMain : TGetItemMainThread;

begin
  setItem := CreateMainThreadBlockingCall('localstorage_setitem');
  removeItem := CreateMainThreadBlockingCall('localstorage_removeitem');
  clear :=  CreateMainThreadBlockingCall('localstorage_clear');

  getItemMain := TGetItemMainThread(CreateMainThreadBlockingCall('localstorage_getitem'));
  getItem := TMainThreadCallFunc(
    function (aName : String) : JSValue
    var
      lDataBuffer : TJSSharedArrayBuffer;
      lStringArray : TJSUInt16Array;
      lErr : TCanvasError;
      lAttempts, lReturnedSize : Integer;
    begin
      lDataBuffer := TJSSharedArrayBuffer.new(16*1024); // initial guess of 16 kb
      lAttempts := 3;
      while lAttempts > 0 do
      begin
        lErr := getItemMain(aName, lDataBuffer);
        case lErr of
          EWASMEVENT_SUCCESS : begin
            lReturnedSize := TJSInt32Array.new(lDataBuffer, 0, 1)[0];
            if lReturnedSize = -1 then
              Exit(JS.Undefined);
            lStringArray := TJSUint16Array.new(lDataBuffer, 4, lReturnedSize);
            Result := TJSFunction(@TJSString.fromCharCode).apply(nil, TJSValueDynArray(lStringArray));
            Exit;
          end;
          EWASMEVENT_BUFFER_SIZE : begin
            lReturnedSize := TJSInt32Array.new(lDataBuffer, 0, 1)[0];
            lDataBuffer := TJSSharedArrayBuffer.new(lReturnedSize*2 + 1024); // adjust size with extra 1 kb margin
          end;
        else
          raise Exception.Create('LocalStorageBridge Error ' + IntToStr(lErr));
        end;
        Dec(lAttempts);
      end;
      raise Exception.Create('LocalStorageBridge failed after multiple attempts');
    end
  );

  asm
    self.localStorage = { getItem, setItem, removeItem, clear };
  end;
end;

// FillImportObject
//
procedure TWasmFresnelWorkerApi.FillImportObject(aObject: TJSObject);
begin
  inherited FillImportObject(aObject);

  // Window

  DeclareMainThreadCall(aObject, 'canvas_allocate_window');
  DeclareMainThreadCall(aObject, 'canvas_deallocate_window');

  DeclareMainThreadCall(aObject, 'window_show_hide');

  aObject['canvas_draw_offscreen_on_window'] := @DrawOffscreenCanvasOnWindowCanvas;

  DeclareMainThreadCall(aObject, 'canvas_getrect');
  DeclareMainThreadCall(aObject, 'canvas_setrect');
  DeclareMainThreadCall(aObject, 'canvas_getsize');
  DeclareMainThreadCall(aObject, 'canvas_setsize');

  DeclareMainThreadCall(aObject, 'canvas_set_title');

  DeclareMainThreadCall(aObject, 'canvas_get_viewport_sizes');

  // Cursor

  DeclareMainThreadCall(aObject, 'cursor_set');

  // RequestAnimationFrame

  aObject['request_animation_frame'] := @RequestAnimationFrame;

  // Clipboard

  DeclareMainThreadCall(aObject, 'clipboard_read_text');
  DeclareMainThreadCall(aObject, 'clipboard_write_text');

  // Event

  aObject['event_set_special_keymap'] := CreateIgnoreCall('event_set_special_keymap');
  DeclareMainThreadFireAndForgetCall(aObject, 'wake_main_thread');

  // Menu

  DeclareMainThreadCall(aObject, 'menu_add_item');
  DeclareMainThreadCall(aObject, 'menu_remove_item');
  DeclareMainThreadCall(aObject, 'menu_update_item');

  // Debug

  aObject['console_log'] := @ConsoleLog;

  // UserMedia

  aObject['usermedia_enumerate'] := @EnumerateUserMedia;
  aObject['usermedia_getenumerated'] := @GetEnumeratedUserMedia;

  DeclareMainThreadCall(aObject, 'usermedia_startcapture');
  DeclareMainThreadCall(aObject, 'usermedia_stopcapture');
  DeclareMainThreadCall(aObject, 'usermedia_iscapturing');

end;

// HandleMenuClick
//
function TWasmFresnelWorkerApi.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;

end.