{ 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(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.