mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-08 22:07:48 +02:00
demo: wasidom: basic call
This commit is contained in:
mattias
parent
c22e573ac3
commit
5fa7378e3c
92
demo/wasienv/dom/BrowserDomTest1.lpi
Normal file
92
demo/wasienv/dom/BrowserDomTest1.lpi
Normal file
@ -0,0 +1,92 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
<Runnable Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="BrowserDomTest1"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<CustomData Count="2">
|
||||
<Item0 Name="MaintainHTML" Value="1"/>
|
||||
<Item1 Name="PasJSWebBrowserProject" Value="1"/>
|
||||
</CustomData>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="BrowserDomTest1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="index.html"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<CustomData Count="1">
|
||||
<Item0 Name="PasJSIsProjectHTMLFile" Value="1"/>
|
||||
</CustomData>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="wadom_browser.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target FileExt=".js">
|
||||
<Filename Value="BrowserDomTest1"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="js"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<AllowLabel Value="False"/>
|
||||
<CPPInline Value="False"/>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<TargetOS Value="browser"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<GenerateDebugInfo Value="False"/>
|
||||
<UseLineInfoUnit Value="False"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc -Jminclude"/>
|
||||
<CompilerPath Value="$(pas2js)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
117
demo/wasienv/dom/BrowserDomTest1.lpr
Normal file
117
demo/wasienv/dom/BrowserDomTest1.lpr
Normal file
@ -0,0 +1,117 @@
|
||||
program BrowserDomTest1;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
uses
|
||||
BrowserConsole, BrowserApp, JS, Classes, SysUtils, Web, WebAssembly, Types,
|
||||
wasienv, wadom_browser;
|
||||
|
||||
Type
|
||||
|
||||
{ TMyApplication }
|
||||
|
||||
TMyApplication = class(TBrowserApplication)
|
||||
Private
|
||||
FWasiEnv: TPas2JSWASIEnvironment;
|
||||
FMemory : TJSWebAssemblyMemory; // Memory of webassembly
|
||||
FTable : TJSWebAssemblyTable; // Table of exported functions
|
||||
FWADomBridge : TWADomBridge;
|
||||
function CreateWebAssembly(Path: string; ImportObject: TJSObject
|
||||
): TJSPromise;
|
||||
procedure DoWrite(Sender: TObject; const aOutput: String);
|
||||
function initEnv(aValue: JSValue): JSValue;
|
||||
procedure InitWebAssembly;
|
||||
Public
|
||||
Constructor Create(aOwner : TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
procedure DoRun; override;
|
||||
end;
|
||||
|
||||
function TMyApplication.InitEnv(aValue: JSValue): JSValue;
|
||||
Var
|
||||
Module : TJSInstantiateResult absolute aValue;
|
||||
Exps : TWASIExports;
|
||||
begin
|
||||
Result:=True;
|
||||
Exps := TWASIExports(TJSObject(Module.Instance.exports_));
|
||||
FWasiEnv.Instance:=Module.Instance;
|
||||
// console.info('got exports', exps);
|
||||
Exps.Start;
|
||||
end;
|
||||
|
||||
procedure TMyApplication.DoWrite(Sender: TObject; const aOutput: String);
|
||||
begin
|
||||
Writeln(aOutput);
|
||||
end;
|
||||
|
||||
constructor TMyApplication.Create(aOwner: TComponent);
|
||||
begin
|
||||
inherited Create(aOwner);
|
||||
FWasiEnv:=TPas2JSWASIEnvironment.Create;
|
||||
FWasiEnv.OnStdErrorWrite:=@DoWrite;
|
||||
FWasiEnv.OnStdOutputWrite:=@DoWrite;
|
||||
FWADomBridge:=TWADomBridge.Create(FWasiEnv);
|
||||
end;
|
||||
|
||||
function TMyApplication.CreateWebAssembly(Path: string; ImportObject: TJSObject): TJSPromise;
|
||||
begin
|
||||
Result:=window.fetch(Path)._then(Function (res : jsValue) : JSValue
|
||||
begin
|
||||
Result:=TJSResponse(Res).arrayBuffer._then(Function (res2 : jsValue) : JSValue
|
||||
begin
|
||||
Result:=TJSWebAssembly.instantiate(TJSArrayBuffer(res2),ImportObject);
|
||||
end,Nil)
|
||||
end,Nil
|
||||
);
|
||||
end;
|
||||
|
||||
procedure TMyApplication.InitWebAssembly;
|
||||
|
||||
Var
|
||||
mDesc : TJSWebAssemblyMemoryDescriptor;
|
||||
tDesc: TJSWebAssemblyTableDescriptor;
|
||||
ImportObj : TJSObject;
|
||||
|
||||
begin
|
||||
// Setup memory
|
||||
mDesc.initial:=256;
|
||||
mDesc.maximum:=256;
|
||||
FMemory:=TJSWebAssemblyMemory.New(mDesc);
|
||||
// Setup table
|
||||
tDesc.initial:=0;
|
||||
tDesc.maximum:=0;
|
||||
tDesc.element:='anyfunc';
|
||||
FTable:=TJSWebAssemblyTable.New(tDesc);
|
||||
// Setup ImportObject
|
||||
ImportObj:=new([
|
||||
'js', new([
|
||||
'mem', FMemory,
|
||||
'tbl', FTable
|
||||
])
|
||||
]);
|
||||
FWasiEnv.AddImports(ImportObj);
|
||||
CreateWebAssembly('WasiDomTest1.wasm',ImportObj)._then(@initEnv);
|
||||
end;
|
||||
|
||||
destructor TMyApplication.Destroy;
|
||||
begin
|
||||
FreeAndNil(FWasiEnv);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TMyApplication.DoRun;
|
||||
|
||||
begin
|
||||
// Your code here
|
||||
Terminate;
|
||||
InitWebAssembly;
|
||||
end;
|
||||
|
||||
var
|
||||
Application : TMyApplication;
|
||||
|
||||
begin
|
||||
Application:=TMyApplication.Create(nil);
|
||||
Application.Initialize;
|
||||
Application.Run;
|
||||
end.
|
||||
72
demo/wasienv/dom/WasiDomTest1.lpi
Normal file
72
demo/wasienv/dom/WasiDomTest1.lpi
Normal file
@ -0,0 +1,72 @@
|
||||
<?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="WasiDomTest1"/>
|
||||
<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="WasiDomTest1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="wadom_wasm.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="WasiDomTest1.wasm" ApplyConventions="False"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<TargetCPU Value="wasm32"/>
|
||||
<TargetOS Value="wasi"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<GenerateDebugInfo Value="False"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerPath Value="/usr/lib/fpc/3.3.1/ppcrosswasm32"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
22
demo/wasienv/dom/WasiDomTest1.lpr
Normal file
22
demo/wasienv/dom/WasiDomTest1.lpr
Normal file
@ -0,0 +1,22 @@
|
||||
program WasiDomTest1;
|
||||
|
||||
{$mode objfpc}
|
||||
{$h+}
|
||||
{$codepage UTF8}
|
||||
|
||||
uses
|
||||
SysUtils, wadom_wasm;
|
||||
|
||||
var
|
||||
obj: TJSObject;
|
||||
d: Double;
|
||||
u: UnicodeString;
|
||||
begin
|
||||
obj:=TJSObject.CreateFromID(-1);
|
||||
d:=obj.InvokeJSDoubleResult('fly',[]);
|
||||
writeln('AAA1 ',d);
|
||||
u:='äbc';
|
||||
d:=obj.InvokeJSDoubleResult('fly',[u,12345678901]);
|
||||
writeln('AAA2 ',d);
|
||||
end.
|
||||
|
||||
1
demo/wasienv/dom/bulma.min.css
vendored
Normal file
1
demo/wasienv/dom/bulma.min.css
vendored
Normal file
File diff suppressed because one or more lines are too long
52
demo/wasienv/dom/index.html
Normal file
52
demo/wasienv/dom/index.html
Normal file
@ -0,0 +1,52 @@
|
||||
|
||||
<!doctype html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta http-equiv="Content-type" content="text/html; charset=utf-8">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||
<title>FPC-Webassembly accesing browser DOM through Pas2JS Demo</title>
|
||||
<link href="bulma.min.css" rel="stylesheet">
|
||||
<script src="BrowserDomTest1.js"></script>
|
||||
<style>
|
||||
|
||||
.source {
|
||||
/* width: 730px; */
|
||||
margin: -45px auto;
|
||||
font-size: 0.9em;
|
||||
}
|
||||
|
||||
.source-inner {
|
||||
display: flex;
|
||||
justify-content: space-between;
|
||||
align-items: center;
|
||||
/* width: 482px; */
|
||||
}
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<div class="section py-4">
|
||||
<h1 class="title is-3">Canvas</h1>
|
||||
<div class="box" id="canvases"></div>
|
||||
</div>
|
||||
<div class="section py-4">
|
||||
<h1 class="title is-3">Console output</h1>
|
||||
<div class="box" id="pasjsconsole"></div>
|
||||
</div>
|
||||
<!-- <hr> -->
|
||||
<div class="section">
|
||||
<div class="source">
|
||||
<div class="source-inner">
|
||||
<div>
|
||||
<p>Created using <a target="_blank" href="https://wiki.freepascal.org/pas2js">pas2js.</a> </p>
|
||||
<p>Pas2JS Sources: <a target="new" href="demowasicanvas.lpr">Pas2JS Program</a></p>
|
||||
<p>Webassembly Sources: <a target="new" href="canvasdraw.lpr">FPC Program</a></p>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<script>
|
||||
rtl.showUncaughtExceptions=true;
|
||||
rtl.run();
|
||||
</script>
|
||||
</body>
|
||||
</html>
|
||||
227
demo/wasienv/dom/wadom_browser.pp
Normal file
227
demo/wasienv/dom/wadom_browser.pp
Normal file
@ -0,0 +1,227 @@
|
||||
unit wadom_browser;
|
||||
|
||||
{$mode objfpc}
|
||||
{$h+}
|
||||
|
||||
interface
|
||||
|
||||
uses sysutils, types, js, web, wasienv, wadom_shared;
|
||||
|
||||
Type
|
||||
|
||||
{ TWADomBridge }
|
||||
|
||||
TWADomBridge = class(TImportExtension)
|
||||
Private
|
||||
FGlobalObjects: TJSArray;
|
||||
FLocalObjects: TJSArray;
|
||||
Protected
|
||||
function FindObject(ObjId: TWasiDomObjectID): TJSObject; virtual;
|
||||
function Invoke_JSResult(ObjId: TWasiDomObjectID; FuncNameP, FuncNameLen, ArgsP: NativeInt; out JSResult: JSValue): TWasiDomResult; virtual;
|
||||
function Invoke_BooleanResult(ObjId: TWasiDomObjectID; FuncNameP, FuncNameLen, ArgsP, ResultP: NativeInt): TWasiDomResult; virtual;
|
||||
function Invoke_DoubleResult(ObjId: TWasiDomObjectID; FuncNameP, FuncNameLen, ArgsP, ResultP: NativeInt): TWasiDomResult; virtual;
|
||||
function GetInvokeArguments(View: TJSDataView; ArgsP: NativeInt): TJSValueDynArray; virtual;
|
||||
function GetWasiDomResult(const v: jsvalue): TWasiDomResult;
|
||||
Public
|
||||
Constructor Create(aEnv: TPas2JSWASIEnvironment); override;
|
||||
Procedure FillImportObject(aObject: TJSObject); override;
|
||||
Function ImportName: String; override;
|
||||
end;
|
||||
|
||||
Implementation
|
||||
|
||||
function TypedArrayToString(const a: TJSTypedArray): string; assembler;
|
||||
asm
|
||||
return String.fromCharCode.apply(null,a);
|
||||
end;
|
||||
|
||||
constructor TWADomBridge.Create(aEnv: TPas2JSWASIEnvironment);
|
||||
begin
|
||||
Inherited Create(aEnv);
|
||||
FGlobalObjects:=TJSArray.new;
|
||||
FGlobalObjects[-WasiObjIdDocument]:=document;
|
||||
FGlobalObjects[-WasiObjIdWindow]:=window;
|
||||
FGlobalObjects[-WasiObjIdConsole]:=console;
|
||||
FGlobalObjects[-WasiObjIdCaches]:=caches;
|
||||
FLocalObjects:=TJSArray.new;
|
||||
end;
|
||||
|
||||
function TWADomBridge.ImportName: String;
|
||||
begin
|
||||
Result:=WasiDomExtName;
|
||||
end;
|
||||
|
||||
procedure TWADomBridge.FillImportObject(aObject: TJSObject);
|
||||
begin
|
||||
aObject[WasiDomInvokeBooleanResult]:=@invoke_booleanresult;
|
||||
aObject[WasiDomInvokeDoubleResult]:=@invoke_doubleresult;
|
||||
end;
|
||||
|
||||
function TWADomBridge.FindObject(ObjId: TWasiDomObjectID): TJSObject;
|
||||
begin
|
||||
if ObjId<0 then
|
||||
Result:=TJSObject(FGlobalObjects[-ObjId])
|
||||
else
|
||||
Result:=TJSObject(FLocalObjects[ObjId]);
|
||||
if isUndefined(Result) then
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TWADomBridge.Invoke_JSResult(ObjId: TWasiDomObjectID; FuncNameP,
|
||||
FuncNameLen, ArgsP: NativeInt; out JSResult: JSValue): TWasiDomResult;
|
||||
var
|
||||
View: TJSDataView;
|
||||
aBytes: TJSUint8Array;
|
||||
FuncName: String;
|
||||
Args: TJSValueDynArray;
|
||||
Obj: TJSObject;
|
||||
fn: JSValue;
|
||||
begin
|
||||
writeln('TWADomBridge.Invoke_JSResult ObjId=',ObjId,' FuncNameP=',FuncNameP,' FuncNameLen=',FuncNameLen,' ArgsP=',ArgsP);
|
||||
|
||||
Obj:=FindObject(ObjId);
|
||||
if Obj=nil then
|
||||
exit(WasiDomResult_UnknownObjId);
|
||||
|
||||
View:=getModuleMemoryDataView();
|
||||
aBytes:=TJSUint8Array.New(View.buffer, FuncNameP, FuncNameLen);
|
||||
writeln('TWADomBridge.Invoke_JSResult aBytes=',aBytes);
|
||||
FuncName:=TypedArrayToString(aBytes);
|
||||
writeln('TWADomBridge.Invoke_JSResult FuncName="',FuncName,'"');
|
||||
|
||||
fn:=Obj[FuncName];
|
||||
if jstypeof(fn)<>'function' then
|
||||
exit(WasiDomResult_NotAFunction);
|
||||
|
||||
if ArgsP=0 then
|
||||
JSResult:=TJSFunction(fn).call(Obj)
|
||||
else begin
|
||||
Args:=GetInvokeArguments(View,ArgsP);
|
||||
JSResult:=TJSFunction(fn).apply(Obj,Args);
|
||||
end;
|
||||
|
||||
exit(WasiDomResult_Success);
|
||||
end;
|
||||
|
||||
function TWADomBridge.Invoke_BooleanResult(ObjId: TWasiDomObjectID; FuncNameP,
|
||||
FuncNameLen, ArgsP, ResultP: NativeInt): TWasiDomResult;
|
||||
var
|
||||
JSResult: JSValue;
|
||||
b: byte;
|
||||
begin
|
||||
// invoke
|
||||
Result:=Invoke_JSResult(ObjId,FuncNameP,FuncNameLen,ArgsP,JSResult);
|
||||
if Result<>WasiDomResult_Success then
|
||||
exit;
|
||||
// check result type
|
||||
if jstypeof(JSResult)<>'boolean' then
|
||||
exit(GetWasiDomResult(JSResult));
|
||||
if JSResult then
|
||||
b:=1
|
||||
else
|
||||
b:=0;
|
||||
// set result
|
||||
getModuleMemoryDataView().setUint8(ResultP, b);
|
||||
Result:=WasiDomResult_Success;
|
||||
end;
|
||||
|
||||
function TWADomBridge.Invoke_DoubleResult(ObjId: TWasiDomObjectID; FuncNameP,
|
||||
FuncNameLen, ArgsP, ResultP: NativeInt): TWasiDomResult;
|
||||
var
|
||||
JSResult: JSValue;
|
||||
begin
|
||||
// invoke
|
||||
Result:=Invoke_JSResult(ObjId,FuncNameP,FuncNameLen,ArgsP,JSResult);
|
||||
if Result<>WasiDomResult_Success then
|
||||
exit;
|
||||
// check result type
|
||||
if jstypeof(JSResult)<>'number' then
|
||||
exit(GetWasiDomResult(JSResult));
|
||||
// set result
|
||||
getModuleMemoryDataView().setFloat64(ResultP, double(JSResult), env.IsLittleEndian);
|
||||
Result:=WasiDomResult_Success;
|
||||
end;
|
||||
|
||||
function TWADomBridge.GetInvokeArguments(View: TJSDataView; ArgsP: NativeInt
|
||||
): TJSValueDynArray;
|
||||
var
|
||||
Cnt, aType: Byte;
|
||||
i: Integer;
|
||||
p: NativeInt;
|
||||
Len, Ptr: LongWord;
|
||||
aBytes: TJSUint8Array;
|
||||
aWords: TJSUint16Array;
|
||||
begin
|
||||
p:=ArgsP;
|
||||
Cnt:=View.getUInt8(p);
|
||||
inc(p);
|
||||
for i:=0 to Cnt-1 do
|
||||
begin
|
||||
aType:=View.getUInt8(p);
|
||||
inc(p);
|
||||
case aType of
|
||||
WasiArgLongint:
|
||||
begin
|
||||
Result[i]:=View.getInt32(p,env.IsLittleEndian);
|
||||
inc(p,4);
|
||||
end;
|
||||
WasiArgDouble:
|
||||
begin
|
||||
Result[i]:=View.getFloat64(p,env.IsLittleEndian);
|
||||
inc(p,8);
|
||||
end;
|
||||
WasiArgTrue:
|
||||
Result[i]:=true;
|
||||
WasiArgFalse:
|
||||
Result[i]:=false;
|
||||
WasiArgChar:
|
||||
begin
|
||||
Result[i]:=chr(View.getUint16(p,env.IsLittleEndian));
|
||||
inc(p,2);
|
||||
end;
|
||||
WasiArgUTF8String:
|
||||
begin
|
||||
Len:=View.getUint32(p,env.IsLittleEndian);
|
||||
inc(p,4);
|
||||
Ptr:=View.getUint32(p,env.IsLittleEndian);
|
||||
inc(p,4);
|
||||
aBytes:=TJSUint8Array.New(View.buffer, Ptr,Len);
|
||||
Result[i]:=TypedArrayToString(aBytes);
|
||||
end;
|
||||
WasiArgUnicodeString:
|
||||
begin
|
||||
Len:=View.getUint32(p,env.IsLittleEndian);
|
||||
inc(p,4);
|
||||
Ptr:=View.getUint32(p,env.IsLittleEndian);
|
||||
inc(p,4);
|
||||
aWords:=TJSUint16Array.New(View.buffer, Ptr,Len);
|
||||
Result[i]:=TypedArrayToString(aWords);
|
||||
end;
|
||||
WasiArgPointer:
|
||||
begin
|
||||
Result[i]:=View.getUint32(p,env.IsLittleEndian);
|
||||
inc(p,4);
|
||||
end
|
||||
else
|
||||
raise Exception.Create('unknown arg type '+IntToStr(aType));
|
||||
end;
|
||||
writeln('TWADomBridge.GetInvokeArguments ',i,'/',Cnt,' = ',Result[i]);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TWADomBridge.GetWasiDomResult(const v: jsvalue): TWasiDomResult;
|
||||
begin
|
||||
case jstypeof(v) of
|
||||
'undefined': Result:=WasiDomResult_Undefined;
|
||||
'boolean': Result:=WasiDomResult_Boolean;
|
||||
'number': Result:=WasiDomResult_Number;
|
||||
'string': Result:=WasiDomResult_String;
|
||||
'symbol': Result:=WasiDomResult_Symbol;
|
||||
'bigint': Result:=WasiDomResult_BigInt;
|
||||
'function': Result:=WasiDomResult_Function;
|
||||
'object': Result:=WasiDomResult_Object;
|
||||
else Result:=WasiDomResult_None;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
68
demo/wasienv/dom/wadom_shared.pp
Normal file
68
demo/wasienv/dom/wadom_shared.pp
Normal file
@ -0,0 +1,68 @@
|
||||
{
|
||||
These types and constants are shared between pas2js and webassembly.
|
||||
}
|
||||
unit wadom_shared;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
TWasiDomObjectID = NativeInt;
|
||||
|
||||
// invoke results
|
||||
type
|
||||
TWasiDomResult = longint;
|
||||
const
|
||||
WasiDomResult_None = 0;
|
||||
WasiDomResult_Success = 1;
|
||||
WasiDomResult_UnknownObjId = 2;
|
||||
WasiDomResult_NotAFunction = 3;
|
||||
WasiDomResult_Undefined = 4;
|
||||
WasiDomResult_Boolean = 5;
|
||||
WasiDomResult_Number = 6;
|
||||
WasiDomResult_Double = 7;
|
||||
WasiDomResult_String = 8;
|
||||
WasiDomResult_Function = 9;
|
||||
WasiDomResult_Object = 10;
|
||||
WasiDomResult_BigInt = 11;
|
||||
WasiDomResult_Symbol = 12;
|
||||
|
||||
WasiDomResultLast = 12;
|
||||
|
||||
WasiDomResult_Names: array[0..WasiDomResultLast] of string = (
|
||||
'None',
|
||||
'Success',
|
||||
'UnknownObjId',
|
||||
'NotAFunction',
|
||||
'Undefined',
|
||||
'Null',
|
||||
'Boolean',
|
||||
'Double',
|
||||
'String',
|
||||
'Function',
|
||||
'Object',
|
||||
'BigInt',
|
||||
'Symbol'
|
||||
);
|
||||
|
||||
WasiDomExtName = 'wasi_dom';
|
||||
WasiDomInvokeBooleanResult = 'invoke_boolresult';
|
||||
WasiDomInvokeDoubleResult = 'invoke_doubleresult';
|
||||
|
||||
WasiArgNone = 0;
|
||||
WasiArgLongint = 1;
|
||||
WasiArgDouble = 2;
|
||||
WasiArgTrue = 3;
|
||||
WasiArgFalse = 4;
|
||||
WasiArgChar = 5; // followed by a word
|
||||
WasiArgUTF8String = 6; // followed by length and pointer
|
||||
WasiArgUnicodeString = 7; // followed by length and pointer
|
||||
WasiArgPointer = 8;
|
||||
|
||||
WasiObjIdDocument = -1;
|
||||
WasiObjIdWindow = -2;
|
||||
WasiObjIdConsole = -3;
|
||||
WasiObjIdCaches = -4;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
428
demo/wasienv/dom/wadom_wasm.pas
Normal file
428
demo/wasienv/dom/wadom_wasm.pas
Normal file
@ -0,0 +1,428 @@
|
||||
{
|
||||
Webassembly unit giving access to the browser DOM.
|
||||
|
||||
see https://wiki.freepascal.org/WebAssembly/DOM
|
||||
}
|
||||
unit wadom_wasm;
|
||||
|
||||
{$mode ObjFPC}{$H+}
|
||||
|
||||
{$define VerboseWasiDom}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Types, Math, Classes, wadom_shared;
|
||||
|
||||
const
|
||||
MinSafeIntDouble = -$1fffffffffffff; // -9007199254740991 54 bits (52 plus signed bit plus implicit highest bit)
|
||||
MaxSafeIntDouble = $1fffffffffffff; // 9007199254740991
|
||||
|
||||
Type
|
||||
EJSObject = class(Exception);
|
||||
EJSInvoke = class(EJSObject)
|
||||
public
|
||||
ObjectID: TWasiDomObjectID;
|
||||
FuncName: string;
|
||||
end;
|
||||
|
||||
TJSObject = class;
|
||||
//TJSObjectClass = class of TJSObject;
|
||||
|
||||
{ TJSObject }
|
||||
|
||||
TJSObject = class(TInterfacedObject)
|
||||
private
|
||||
FObjectID: TWasiDomObjectID;
|
||||
protected
|
||||
procedure WasiInvokeRaise(const aName, Msg: string); virtual;
|
||||
procedure WasiInvokeRaiseResultMismatch(const aName: string; Expected, Actual: TWasiDomResult); virtual;
|
||||
function CreateInvokeJSArgs(const Args: array of const): PByte; virtual;
|
||||
public
|
||||
constructor CreateFromID(aID: TWasiDomObjectID); reintroduce;
|
||||
destructor Destroy; override;
|
||||
property ObjectID: TWasiDomObjectID read FObjectID;
|
||||
function InvokeJSBooleanResult(const aName: string; Const args: Array of const): Boolean;
|
||||
function InvokeJSDoubleResult(const aName: string; Const Args: Array of const): Double;
|
||||
//function InvokeJSUnicodeStringResult(const aName: string; Const args: Array of const): UnicodeString;
|
||||
//function InvokeJSUtf8StringResult(const aName: string; Const args: Array of const): String;
|
||||
//function InvokeJSObjResult(const aName: string; aResultClass: TJSObjectClass; Const args: Array of const): TJSObject;
|
||||
end;
|
||||
|
||||
function __wasidom_invoke_boolresult(
|
||||
ObjID: TWasiDomObjectID;
|
||||
FuncNameP: PChar;
|
||||
FuncNameLen: longint;
|
||||
ArgP: PByte;
|
||||
ResultP: PByteBool
|
||||
): TWasiDomResult; external WasiDomExtName name WasiDomInvokeBooleanResult;
|
||||
|
||||
function __wasidom_invoke_doubleresult(
|
||||
ObjID: TWasiDomObjectID;
|
||||
FuncNameP: PChar;
|
||||
FuncNameLen: longint;
|
||||
ArgP: PByte;
|
||||
ResultP: PDouble
|
||||
): TWasiDomResult; external WasiDomExtName name WasiDomInvokeDoubleResult;
|
||||
|
||||
implementation
|
||||
|
||||
{$IFDEF VerboseWasiDom}
|
||||
function GetVarRecName(vt: word): string;
|
||||
begin
|
||||
case vt of
|
||||
vtInteger: Result:='vtInteger';
|
||||
vtBoolean: Result:='vtBoolean';
|
||||
vtChar: Result:='vtChar';
|
||||
{$ifndef FPUNONE}
|
||||
vtExtended: Result:='vtExtended';
|
||||
{$endif}
|
||||
vtString: Result:='vtString';
|
||||
vtPointer: Result:='vtPointer';
|
||||
vtPChar: Result:='vtPChar';
|
||||
vtObject: Result:='vtObject';
|
||||
vtClass: Result:='vtClass';
|
||||
vtWideChar: Result:='vtWideChar';
|
||||
vtPWideChar: Result:='vtPWideChar';
|
||||
vtAnsiString: Result:='vtAnsiString';
|
||||
vtCurrency: Result:='vtCurrency';
|
||||
vtVariant: Result:='vtVariant';
|
||||
vtInterface: Result:='vtInterface';
|
||||
vtWideString: Result:='vtWideString';
|
||||
vtInt64: Result:='vtInt64';
|
||||
vtQWord: Result:='vtQWord';
|
||||
vtUnicodeString: Result:='vtUnicodeString';
|
||||
else
|
||||
Result:='vt?';
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{ TJSObject }
|
||||
|
||||
procedure TJSObject.WasiInvokeRaise(const aName, Msg: string);
|
||||
var
|
||||
E: EJSInvoke;
|
||||
begin
|
||||
E:=EJSInvoke.Create(Msg);
|
||||
E.ObjectID:=ObjectID;
|
||||
E.FuncName:=aName;
|
||||
raise E;
|
||||
end;
|
||||
|
||||
procedure TJSObject.WasiInvokeRaiseResultMismatch(const aName: string;
|
||||
Expected, Actual: TWasiDomResult);
|
||||
begin
|
||||
case Actual of
|
||||
WasiDomResult_UnknownObjId: WasiInvokeRaise(aName,'unknown object id '+IntToStr(ObjectID));
|
||||
WasiDomResult_NotAFunction: WasiInvokeRaise(aName,'object '+IntToStr(ObjectID)+' does not have a function "'+aName+'"');
|
||||
else
|
||||
WasiInvokeRaise(aName,'expected '+WasiDomResult_Names[Expected]+', but got '+WasiDomResult_Names[Actual]+' from object '+IntToStr(ObjectID)+' function "'+aName+'"');
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJSObject.CreateInvokeJSArgs(const Args: array of const): PByte;
|
||||
|
||||
procedure RaiseNotSupported(const Msg: string);
|
||||
begin
|
||||
raise EJSInvoke.Create('Invoke js: type not supported '+Msg);
|
||||
end;
|
||||
|
||||
procedure RaiseRange;
|
||||
begin
|
||||
raise ERangeError.Create('Invoke js: number out of bounds');
|
||||
end;
|
||||
|
||||
var
|
||||
i, Len: Integer;
|
||||
qw: QWord;
|
||||
i64: Int64;
|
||||
p, h: PByte;
|
||||
s: String;
|
||||
ws: WideString;
|
||||
us: UnicodeString;
|
||||
d: Double;
|
||||
begin
|
||||
Result:=nil;
|
||||
if length(Args)>255 then
|
||||
raise EJSInvoke.Create('Invoke js: too many args');
|
||||
|
||||
Len:=1;
|
||||
for i:=0 to high(Args) do
|
||||
begin
|
||||
case Args[i].VType of
|
||||
vtInteger : inc(Len,5);
|
||||
vtBoolean : inc(Len);
|
||||
vtChar,
|
||||
vtWideChar : inc(Len,3);
|
||||
{$ifndef FPUNONE}
|
||||
vtExtended :
|
||||
begin
|
||||
d:=double(Args[i].VExtended^);
|
||||
if d=0 then ;
|
||||
inc(Len,9);
|
||||
end;
|
||||
{$endif}
|
||||
vtString : inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
|
||||
vtPointer,
|
||||
vtPChar :
|
||||
begin
|
||||
strlen(Args[i].VPChar);
|
||||
inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
|
||||
end;
|
||||
vtObject : RaiseNotSupported('object');
|
||||
vtClass : RaiseNotSupported('class');
|
||||
vtPWideChar : RaiseNotSupported('pwidechar');
|
||||
vtAnsiString : inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
|
||||
vtCurrency : RaiseNotSupported('currency');
|
||||
{$ifdef FPC_HAS_FEATURE_VARIANTS}
|
||||
vtVariant : RaiseNotSupported('variant');
|
||||
{$endif FPC_HAS_FEATURE_VARIANTS}
|
||||
vtInterface : RaiseNotSupported('interface');
|
||||
vtWideString : inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
|
||||
vtInt64 :
|
||||
begin
|
||||
i64:=Args[i].VInt64^;
|
||||
if (i64<MinSafeIntDouble) or (i64>MaxSafeIntDouble) then
|
||||
RaiseRange;
|
||||
if (i64>=low(longint)) and (i64<=high(longint)) then
|
||||
inc(Len,5)
|
||||
else
|
||||
inc(Len,9);
|
||||
end;
|
||||
vtUnicodeString : inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
|
||||
vtQWord :
|
||||
begin
|
||||
qw:=Args[i].VQWord^;
|
||||
if (qw>MaxSafeIntDouble) then
|
||||
RaiseRange;
|
||||
if (qw<=high(longint)) then
|
||||
inc(Len,5)
|
||||
else
|
||||
inc(Len,9);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Result:=GetMem(Len);
|
||||
p:=Result;
|
||||
p^:=length(Args);
|
||||
inc(p);
|
||||
for i:=0 to high(Args) do
|
||||
begin
|
||||
case Args[i].VType of
|
||||
vtInteger :
|
||||
begin
|
||||
p^:=WasiArgLongint;
|
||||
inc(p);
|
||||
PLongint(p)^:=Args[i].VInteger;
|
||||
inc(p,4);
|
||||
end;
|
||||
vtBoolean :
|
||||
begin
|
||||
if Args[i].VBoolean then
|
||||
p^:=WasiArgTrue
|
||||
else
|
||||
p^:=WasiArgFalse;
|
||||
inc(p);
|
||||
end;
|
||||
{$ifndef FPUNONE}
|
||||
vtExtended :
|
||||
begin
|
||||
p^:=WasiArgDouble;
|
||||
inc(p);
|
||||
PDouble(p)^:=double(Args[i].VExtended^);
|
||||
inc(p,8);
|
||||
end;
|
||||
{$endif}
|
||||
vtChar:
|
||||
begin
|
||||
p^:=WasiArgChar;
|
||||
inc(p);
|
||||
PWord(p)^:=ord(Args[i].VChar);
|
||||
inc(p,2);
|
||||
end;
|
||||
vtWideChar :
|
||||
begin
|
||||
p^:=WasiArgChar;
|
||||
inc(p);
|
||||
PWord(p)^:=ord(Args[i].VWideChar);
|
||||
inc(p,2);
|
||||
end;
|
||||
vtString :
|
||||
begin
|
||||
// shortstring
|
||||
p^:=WasiArgUTF8String;
|
||||
inc(p);
|
||||
h:=PByte(Args[i].VString);
|
||||
PNativeInt(p)^:=h^;
|
||||
inc(h);
|
||||
inc(p,sizeof(NativeInt));
|
||||
PPointer(p)^:=h;
|
||||
inc(p,sizeof(Pointer));
|
||||
end;
|
||||
vtPointer:
|
||||
begin
|
||||
p^:=WasiArgPointer;
|
||||
inc(p);
|
||||
PPointer(p)^:=Args[i].VPointer;
|
||||
inc(p,sizeof(Pointer));
|
||||
end;
|
||||
vtPChar :
|
||||
begin
|
||||
p^:=WasiArgUTF8String;
|
||||
inc(p);
|
||||
h:=PByte(Args[i].VPChar);
|
||||
PNativeInt(p)^:=strlen(PChar(h));
|
||||
inc(p,sizeof(NativeInt));
|
||||
PPointer(p)^:=h;
|
||||
inc(p,sizeof(Pointer));
|
||||
end;
|
||||
vtObject : ;
|
||||
vtClass : ;
|
||||
vtPWideChar : ;
|
||||
vtAnsiString :
|
||||
begin
|
||||
p^:=WasiArgUTF8String;
|
||||
inc(p);
|
||||
h:=Args[i].VAnsiString;
|
||||
s:=AnsiString(h);
|
||||
PNativeInt(p)^:=length(s);
|
||||
inc(p,sizeof(NativeInt));
|
||||
PPointer(p)^:=h;
|
||||
inc(p,sizeof(Pointer));
|
||||
end;
|
||||
vtCurrency : ;
|
||||
{$ifdef FPC_HAS_FEATURE_VARIANTS}
|
||||
vtVariant : ;
|
||||
{$endif FPC_HAS_FEATURE_VARIANTS}
|
||||
vtInterface : ;
|
||||
vtWideString :
|
||||
begin
|
||||
p^:=WasiArgUnicodeString;
|
||||
inc(p);
|
||||
h:=Args[i].VWideString;
|
||||
ws:=WideString(h);
|
||||
PNativeInt(p)^:=length(ws);
|
||||
inc(p,sizeof(NativeInt));
|
||||
PPointer(p)^:=h;
|
||||
inc(p,sizeof(Pointer));
|
||||
end;
|
||||
vtInt64 :
|
||||
begin
|
||||
i64:=Args[i].VInt64^;
|
||||
if (i64>=low(longint)) and (i64<=high(longint)) then
|
||||
begin
|
||||
p^:=WasiArgLongint;
|
||||
inc(p);
|
||||
PLongint(p)^:=i64;
|
||||
inc(p,4);
|
||||
end else begin
|
||||
p^:=WasiArgDouble;
|
||||
inc(p);
|
||||
PDouble(p)^:=i64;
|
||||
inc(p,8);
|
||||
end;
|
||||
end;
|
||||
vtUnicodeString :
|
||||
begin
|
||||
p^:=WasiArgUnicodeString;
|
||||
inc(p);
|
||||
h:=Args[i].VUnicodeString;
|
||||
us:=UnicodeString(h);
|
||||
PNativeInt(p)^:=length(us);
|
||||
inc(p,sizeof(NativeInt));
|
||||
PPointer(p)^:=h;
|
||||
inc(p,sizeof(Pointer));
|
||||
end;
|
||||
vtQWord :
|
||||
begin
|
||||
qw:=Args[i].VQWord^;
|
||||
if (qw<=high(longint)) then
|
||||
begin
|
||||
p^:=WasiArgLongint;
|
||||
inc(p);
|
||||
PLongint(p)^:=qw;
|
||||
inc(p,4);
|
||||
end else begin
|
||||
p^:=WasiArgDouble;
|
||||
inc(p);
|
||||
PDouble(p)^:=qw;
|
||||
inc(p,8);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF VerboseInvokeJSArgs}
|
||||
s:='TJSObject.CreateInvokeJSArgs ArgCnt='+IntToStr(length(Args));
|
||||
for i:=0 to high(Args) do
|
||||
s:=s+' '+GetVarRecName(Args[i].VType);
|
||||
s:=s+' Len='+IntToStr(Len);
|
||||
s:=s+' Bytes=';
|
||||
for i:=0 to Len-1 do
|
||||
s:=s+HexStr(Result[i],2);
|
||||
writeln(s);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
constructor TJSObject.CreateFromID(aID: TWasiDomObjectID);
|
||||
begin
|
||||
FObjectID:=aID;
|
||||
end;
|
||||
|
||||
destructor TJSObject.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TJSObject.InvokeJSBooleanResult(const aName: string;
|
||||
const args: array of const): Boolean;
|
||||
var
|
||||
aError: TWasiDomResult;
|
||||
InvokeArgs: PByte;
|
||||
b: bytebool;
|
||||
begin
|
||||
b:=false;
|
||||
if length(Args)=0 then
|
||||
aError:=__wasidom_invoke_boolresult(ObjectID,PChar(aName),length(aName),nil,@b)
|
||||
else begin
|
||||
InvokeArgs:=CreateInvokeJSArgs(Args);
|
||||
try
|
||||
aError:=__wasidom_invoke_boolresult(ObjectID,PChar(aName),length(aName),
|
||||
InvokeArgs,@b);
|
||||
finally
|
||||
if InvokeArgs<>nil then
|
||||
FreeMem(InvokeArgs);
|
||||
end;
|
||||
end;
|
||||
if aError<>WasiDomResult_Boolean then
|
||||
WasiInvokeRaiseResultMismatch(aName,WasiDomResult_Boolean,aError);
|
||||
Result:=b;
|
||||
end;
|
||||
|
||||
function TJSObject.InvokeJSDoubleResult(const aName: string;
|
||||
const Args: array of const): Double;
|
||||
var
|
||||
aError: TWasiDomResult;
|
||||
InvokeArgs: PByte;
|
||||
begin
|
||||
Result:=NaN;
|
||||
if length(Args)=0 then
|
||||
aError:=__wasidom_invoke_doubleresult(ObjectID,PChar(aName),length(aName),nil,@Result)
|
||||
else begin
|
||||
InvokeArgs:=CreateInvokeJSArgs(Args);
|
||||
try
|
||||
aError:=__wasidom_invoke_doubleresult(ObjectID,PChar(aName),length(aName),
|
||||
InvokeArgs,@Result);
|
||||
finally
|
||||
if InvokeArgs<>nil then
|
||||
FreeMem(InvokeArgs);
|
||||
end;
|
||||
end;
|
||||
if aError<>WasiDomResult_Double then
|
||||
WasiInvokeRaiseResultMismatch(aName,WasiDomResult_Double,aError);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user