mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-05 18:17:45 +02:00
wasi job: started callback
This commit is contained in:
mattias
parent
c41a54be66
commit
32c19ae0ec
4
.gitmodules
vendored
4
.gitmodules
vendored
@ -1,4 +0,0 @@
|
||||
[submodule "compiler"]
|
||||
path = compiler
|
||||
url = ../source
|
||||
branch = main
|
||||
1
compiler
1
compiler
@ -1 +0,0 @@
|
||||
Subproject commit 1dd80d596d0f11601c6c834df19cc1916bf9ea6b
|
||||
@ -33,11 +33,11 @@ Type
|
||||
FWasiEnv: TPas2JSWASIEnvironment;
|
||||
FMemory : TJSWebAssemblyMemory; // Memory of webassembly
|
||||
FTable : TJSWebAssemblyTable; // Table of exported functions
|
||||
FWADomBridge : TJOBBridge;
|
||||
FWADomBridge : TJSObjectBridge;
|
||||
function CreateWebAssembly(Path: string; ImportObject: TJSObject
|
||||
): TJSPromise;
|
||||
procedure DoWrite(Sender: TObject; const aOutput: String);
|
||||
function initEnv(aValue: JSValue): JSValue;
|
||||
function InitEnv(aValue: JSValue): JSValue;
|
||||
procedure InitWebAssembly;
|
||||
Public
|
||||
Constructor Create(aOwner : TComponent); override;
|
||||
@ -123,12 +123,17 @@ function TMyApplication.InitEnv(aValue: JSValue): JSValue;
|
||||
Var
|
||||
Module : TJSInstantiateResult absolute aValue;
|
||||
Exps : TWASIExports;
|
||||
InitFunc: TProc;
|
||||
begin
|
||||
Result:=True;
|
||||
Exps := TWASIExports(TJSObject(Module.Instance.exports_));
|
||||
FWasiEnv.Instance:=Module.Instance;
|
||||
// console.info('got exports', exps);
|
||||
Exps.Start;
|
||||
Exps := TWASIExports(TJSObject(Module.Instance.exports_));
|
||||
//writeln('TMyApplication.InitEnv wasm exports=',TJSObject.keys(Exps));
|
||||
FWADomBridge.WasiExports:=Exps;
|
||||
|
||||
// init the library
|
||||
InitFunc:=TProc(Exps.functions['_initialize']);
|
||||
InitFunc();
|
||||
end;
|
||||
|
||||
{ TMyApplication }
|
||||
@ -144,7 +149,7 @@ begin
|
||||
FWasiEnv:=TPas2JSWASIEnvironment.Create;
|
||||
FWasiEnv.OnStdErrorWrite:=@DoWrite;
|
||||
FWasiEnv.OnStdOutputWrite:=@DoWrite;
|
||||
FWADomBridge:=TJOBBridge.Create(FWasiEnv);
|
||||
FWADomBridge:=TJSObjectBridge.Create(FWasiEnv);
|
||||
|
||||
if FWADomBridge.RegisterGlobalObject(TJSObject(TBird.Create('Root')))<>JObjIdBird then
|
||||
raise Exception.Create('Root TBird wrong number');
|
||||
@ -187,7 +192,7 @@ begin
|
||||
])
|
||||
]);
|
||||
FWasiEnv.AddImports(ImportObj);
|
||||
CreateWebAssembly('WasiDomTest1.wasm',ImportObj)._then(@initEnv);
|
||||
CreateWebAssembly('WasiDomTest1.wasm',ImportObj)._then(@InitEnv);
|
||||
end;
|
||||
|
||||
destructor TMyApplication.Destroy;
|
||||
|
||||
@ -62,6 +62,9 @@
|
||||
<Debugging>
|
||||
<GenerateDebugInfo Value="False"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<ExecutableType Value="Library"/>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerPath Value="/usr/lib/fpc/3.3.1/ppcrosswasm32"/>
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
program WasiDomTest1;
|
||||
library WasiDomTest1;
|
||||
|
||||
{$mode objfpc}
|
||||
{$h+}
|
||||
@ -27,6 +27,69 @@ type
|
||||
property Child: TBird read GetChild write SetChild;
|
||||
end;
|
||||
|
||||
{ TWasmApp }
|
||||
|
||||
TWasmApp = class
|
||||
private
|
||||
function OnPlaygroundClick(Event: IEventListenerEvent): boolean;
|
||||
public
|
||||
procedure Run;
|
||||
end;
|
||||
|
||||
{ TApplication }
|
||||
|
||||
function TWasmApp.OnPlaygroundClick(Event: IEventListenerEvent): boolean;
|
||||
begin
|
||||
writeln('TWasmApp.OnPlaygroundClick ');
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure TWasmApp.Run;
|
||||
var
|
||||
obj: TJSObject;
|
||||
Freddy, Alice, aBird: TBird;
|
||||
JSValue: TJOB_JSValue;
|
||||
JSElem: IJSElement;
|
||||
begin
|
||||
JSElem:=JSDocument.getElementById('playground');
|
||||
writeln('TWasmApp.Run playground classname=',JSElem._ClassName);
|
||||
|
||||
writeln('TWasmApp.Run addEventListener click...');
|
||||
JSElem.addEventListener('click',@OnPlaygroundClick);
|
||||
writeln('TWasmApp.Run ');
|
||||
|
||||
exit;
|
||||
|
||||
obj:=TJSObject.CreateFromID(JObjIdBird);
|
||||
obj.WriteJSPropertyUnicodeString('Caption','Root');
|
||||
writeln('AAA1 ');
|
||||
//u:='äbc';
|
||||
|
||||
//obj.InvokeJSNoResult('Proc',[]);
|
||||
//d:=obj.InvokeJSDoubleResult('GetDouble',[u,12345678901]);
|
||||
writeln('Create Freddy...');
|
||||
Freddy:=obj.InvokeJSObjectResult('CreateChick',['Freddy'],TBird) as TBird;
|
||||
writeln('AAA5 ',Freddy.Name);
|
||||
|
||||
writeln('Create Alice...');
|
||||
Alice:=obj.InvokeJSObjectResult('CreateChick',['Alice'],TBird) as TBird;
|
||||
writeln('Freddy.Child:=Alice...');
|
||||
Freddy.Child:=Alice;
|
||||
aBird:=Freddy.Child;
|
||||
writeln('Freddy.Child=',aBird.Name);
|
||||
|
||||
//Freddy.Size:=123;
|
||||
//writeln('Freddy.Size=',Freddy.Size);
|
||||
JSValue:=Freddy.ReadJSPropertyValue('Child');
|
||||
writeln('JSValue: ',JSValue.Kind,' ',JSValue.AsString);
|
||||
|
||||
writeln('Freeing Freddy...');
|
||||
Freddy.Free;
|
||||
writeln('Freeing Alice...');
|
||||
Alice.Free;
|
||||
|
||||
end;
|
||||
|
||||
{ TBird }
|
||||
|
||||
function TBird.GetName: string;
|
||||
@ -69,51 +132,19 @@ begin
|
||||
Result:=InvokeJSLongIntResult('GetInteger',[]);
|
||||
end;
|
||||
|
||||
var
|
||||
obj: TJSObject;
|
||||
d: Double;
|
||||
u: UnicodeString;
|
||||
Freddy, Alice, aBird: TBird;
|
||||
i: Integer;
|
||||
JSValue: TJOB_JSValue;
|
||||
JSElem: IJSElement;
|
||||
aDate: IJSDate;
|
||||
function JOBCallback(Func, Data, Code, Args: NativeInt): word;
|
||||
begin
|
||||
JSElem:=JSDocument.getElementById('playground');
|
||||
writeln('Class=',JSElem._ClassName);
|
||||
writeln('MyCallBack2 Func=',Func,' Data=',Data,' Code=',Code,' Args=',Args);
|
||||
Result:=Func+123;
|
||||
end;
|
||||
|
||||
aDate:=JSDate.Create(2003,2,5,8,47,30,777);
|
||||
u:=aDate.toLocaleDateString;
|
||||
writeln('toLocaleDateString=',u);
|
||||
exports
|
||||
JOBCallback;
|
||||
|
||||
exit;
|
||||
|
||||
obj:=TJSObject.CreateFromID(JObjIdBird);
|
||||
obj.WriteJSPropertyUnicodeString('Caption','Root');
|
||||
writeln('AAA1 ');
|
||||
u:='äbc';
|
||||
|
||||
//obj.InvokeJSNoResult('Proc',[]);
|
||||
//d:=obj.InvokeJSDoubleResult('GetDouble',[u,12345678901]);
|
||||
writeln('Create Freddy...');
|
||||
Freddy:=obj.InvokeJSObjectResult('CreateChick',['Freddy'],TBird) as TBird;
|
||||
writeln('AAA5 ',Freddy.Name);
|
||||
|
||||
writeln('Create Alice...');
|
||||
Alice:=obj.InvokeJSObjectResult('CreateChick',['Alice'],TBird) as TBird;
|
||||
writeln('Freddy.Child:=Alice...');
|
||||
Freddy.Child:=Alice;
|
||||
aBird:=Freddy.Child;
|
||||
writeln('Freddy.Child=',aBird.Name);
|
||||
|
||||
//Freddy.Size:=123;
|
||||
//writeln('Freddy.Size=',Freddy.Size);
|
||||
JSValue:=Freddy.ReadJSPropertyValue('Child');
|
||||
writeln('JSValue: ',JSValue.Kind,' ',JSValue.AsString);
|
||||
|
||||
writeln('Freeing Freddy...');
|
||||
Freddy.Free;
|
||||
writeln('Freeing Alice...');
|
||||
Alice.Free;
|
||||
var
|
||||
Application: TWasmApp;
|
||||
begin
|
||||
Application:=TWasmApp.Create;
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
|
||||
@ -26,7 +26,7 @@
|
||||
<body>
|
||||
<div class="section py-4">
|
||||
<h1 class="title is-3">Test Area</h1>
|
||||
<div class="box" id="playground"></div>
|
||||
<div class="box" id="playground">Playground</div>
|
||||
</div>
|
||||
<div class="section py-4">
|
||||
<h1 class="title is-3">Console output</h1>
|
||||
|
||||
@ -13,18 +13,24 @@ uses sysutils, types, js, web, wasienv, JOB_Shared;
|
||||
|
||||
Type
|
||||
EJOBBridge = class(Exception);
|
||||
TWasmNativeInt = Longword;
|
||||
TJOBCallback = function(aCall, aData, aCode, Args: TWasmNativeInt): jsvalue;
|
||||
|
||||
{ TJOBBridge }
|
||||
{ TJSObjectBridge }
|
||||
|
||||
TJOBBridge = class(TImportExtension)
|
||||
TJSObjectBridge = class(TImportExtension)
|
||||
Private
|
||||
FCallbackHandler: TJOBCallback;
|
||||
FGlobalObjects: TJSArray;
|
||||
FLocalObjects: TJSArray;
|
||||
FFreeLocalIds: TJSArray; // free positions in FLocalObjects
|
||||
FStringResult: string;
|
||||
FWasiExports: TWASIExports;
|
||||
procedure SetWasiExports(const AValue: TWASIExports);
|
||||
Protected
|
||||
function Invoke_JSResult(ObjId: TJOBObjectID; NameP, NameLen, Invoke, ArgsP: NativeInt; out JSResult: JSValue): TJOBResult; virtual;
|
||||
function GetInvokeArguments(View: TJSDataView; ArgsP: NativeInt): TJSValueDynArray; virtual;
|
||||
function CreateCallbackArgs(View: TJSDataView; const Args: TJSFunctionArguments): TWasmNativeInt; virtual;
|
||||
// exports
|
||||
function Invoke_NoResult(ObjId: TJOBObjectID; NameP, NameLen, Invoke, ArgsP: NativeInt): TJOBResult; virtual;
|
||||
function Invoke_BooleanResult(ObjId: TJOBObjectID; NameP, NameLen, Invoke, ArgsP, ResultP: NativeInt): TJOBResult; virtual;
|
||||
@ -43,6 +49,8 @@ Type
|
||||
function RegisterLocalObject(Obj: TJSObject): TJOBObjectID; virtual;
|
||||
Function RegisterGlobalObject(Obj: TJSObject): TJOBObjectID; virtual;
|
||||
Function GetJOBResult(v: jsvalue): TJOBResult;
|
||||
property CallbackHandler: TJOBCallback read FCallbackHandler write FCallbackHandler;
|
||||
property WasiExports: TWASIExports read FWasiExports write SetWasiExports;
|
||||
end;
|
||||
|
||||
Implementation
|
||||
@ -85,7 +93,7 @@ asm
|
||||
}
|
||||
end;
|
||||
|
||||
constructor TJOBBridge.Create(aEnv: TPas2JSWASIEnvironment);
|
||||
constructor TJSObjectBridge.Create(aEnv: TPas2JSWASIEnvironment);
|
||||
begin
|
||||
Inherited Create(aEnv);
|
||||
FGlobalObjects:=TJSArray.new;
|
||||
@ -113,17 +121,17 @@ begin
|
||||
FFreeLocalIds:=TJSArray.new;
|
||||
end;
|
||||
|
||||
function TJOBBridge.ImportName: String;
|
||||
function TJSObjectBridge.ImportName: String;
|
||||
begin
|
||||
Result:=JOBExportName;
|
||||
end;
|
||||
|
||||
function TJOBBridge.RegisterGlobalObject(Obj: TJSObject): TJOBObjectID;
|
||||
function TJSObjectBridge.RegisterGlobalObject(Obj: TJSObject): TJOBObjectID;
|
||||
begin
|
||||
Result:=-(FGlobalObjects.push(Obj)-1);
|
||||
end;
|
||||
|
||||
procedure TJOBBridge.FillImportObject(aObject: TJSObject);
|
||||
procedure TJSObjectBridge.FillImportObject(aObject: TJSObject);
|
||||
begin
|
||||
aObject[JOBFn_InvokeNoResult]:=@Invoke_NoResult;
|
||||
aObject[JOBFn_InvokeBooleanResult]:=@Invoke_BooleanResult;
|
||||
@ -136,7 +144,7 @@ begin
|
||||
aObject[JOBFn_InvokeJSValueResult]:=@Invoke_JSValueResult;
|
||||
end;
|
||||
|
||||
function TJOBBridge.FindObject(ObjId: TJOBObjectID): TJSObject;
|
||||
function TJSObjectBridge.FindObject(ObjId: TJOBObjectID): TJSObject;
|
||||
begin
|
||||
if ObjId<0 then
|
||||
Result:=TJSObject(FGlobalObjects[-ObjId])
|
||||
@ -146,7 +154,7 @@ begin
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TJOBBridge.RegisterLocalObject(Obj: TJSObject): TJOBObjectID;
|
||||
function TJSObjectBridge.RegisterLocalObject(Obj: TJSObject): TJOBObjectID;
|
||||
var
|
||||
NewId: JSValue;
|
||||
begin
|
||||
@ -162,7 +170,17 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJOBBridge.Invoke_JSResult(ObjId: TJOBObjectID; NameP, NameLen,
|
||||
procedure TJSObjectBridge.SetWasiExports(const AValue: TWASIExports);
|
||||
begin
|
||||
if FWasiExports=AValue then Exit;
|
||||
FWasiExports:=AValue;
|
||||
if FWasiExports<>nil then
|
||||
CallbackHandler:=TJOBCallback(FWasiExports.functions[JOBFn_CallbackHandler])
|
||||
else
|
||||
CallbackHandler:=nil;
|
||||
end;
|
||||
|
||||
function TJSObjectBridge.Invoke_JSResult(ObjId: TJOBObjectID; NameP, NameLen,
|
||||
Invoke, ArgsP: NativeInt; out JSResult: JSValue): TJOBResult;
|
||||
var
|
||||
View: TJSDataView;
|
||||
@ -237,7 +255,7 @@ begin
|
||||
Result:=JOBResult_Success;
|
||||
end;
|
||||
|
||||
function TJOBBridge.Invoke_NoResult(ObjId: TJOBObjectID; NameP, NameLen,
|
||||
function TJSObjectBridge.Invoke_NoResult(ObjId: TJOBObjectID; NameP, NameLen,
|
||||
Invoke, ArgsP: NativeInt): TJOBResult;
|
||||
var
|
||||
JSResult: JSValue;
|
||||
@ -246,7 +264,7 @@ begin
|
||||
Result:=Invoke_JSResult(ObjId,NameP,NameLen,Invoke,ArgsP,JSResult);
|
||||
end;
|
||||
|
||||
function TJOBBridge.Invoke_BooleanResult(ObjId: TJOBObjectID; NameP, NameLen,
|
||||
function TJSObjectBridge.Invoke_BooleanResult(ObjId: TJOBObjectID; NameP, NameLen,
|
||||
Invoke, ArgsP, ResultP: NativeInt): TJOBResult;
|
||||
var
|
||||
JSResult: JSValue;
|
||||
@ -268,7 +286,7 @@ begin
|
||||
Result:=JOBResult_Boolean;
|
||||
end;
|
||||
|
||||
function TJOBBridge.Invoke_DoubleResult(ObjId: TJOBObjectID; NameP, NameLen,
|
||||
function TJSObjectBridge.Invoke_DoubleResult(ObjId: TJOBObjectID; NameP, NameLen,
|
||||
Invoke, ArgsP, ResultP: NativeInt): TJOBResult;
|
||||
var
|
||||
JSResult: JSValue;
|
||||
@ -285,7 +303,7 @@ begin
|
||||
Result:=JOBResult_Double;
|
||||
end;
|
||||
|
||||
function TJOBBridge.Invoke_StringResult(ObjId: TJOBObjectID; NameP, NameLen,
|
||||
function TJSObjectBridge.Invoke_StringResult(ObjId: TJOBObjectID; NameP, NameLen,
|
||||
Invoke, ArgsP, ResultP: NativeInt): TJOBResult;
|
||||
var
|
||||
JSResult: JSValue;
|
||||
@ -305,7 +323,7 @@ begin
|
||||
getModuleMemoryDataView().setInt32(ResultP, length(FStringResult), env.IsLittleEndian);
|
||||
end;
|
||||
|
||||
function TJOBBridge.Invoke_ObjectResult(ObjId: TJOBObjectID; NameP, NameLen,
|
||||
function TJSObjectBridge.Invoke_ObjectResult(ObjId: TJOBObjectID; NameP, NameLen,
|
||||
Invoke, ArgsP, ResultP: NativeInt): TJOBResult;
|
||||
var
|
||||
t: String;
|
||||
@ -329,7 +347,7 @@ begin
|
||||
Result:=JOBResult_Object;
|
||||
end;
|
||||
|
||||
function TJOBBridge.Invoke_JSValueResult(ObjId: TJOBObjectID; NameP, NameLen,
|
||||
function TJSObjectBridge.Invoke_JSValueResult(ObjId: TJOBObjectID; NameP, NameLen,
|
||||
Invoke, ArgsP, ResultP: NativeInt): TJOBResult;
|
||||
var
|
||||
JSResult: JSValue;
|
||||
@ -367,10 +385,12 @@ begin
|
||||
NewId:=RegisterLocalObject(TJSObject(JSResult));
|
||||
getModuleMemoryDataView().setUint32(ResultP, longword(NewId), env.IsLittleEndian);
|
||||
end;
|
||||
else
|
||||
// no args
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJOBBridge.ReleaseObject(ObjId: TJOBObjectID): TJOBResult;
|
||||
function TJSObjectBridge.ReleaseObject(ObjId: TJOBObjectID): TJOBResult;
|
||||
begin
|
||||
//writeln('TJOBBridge.ReleaseObject ',ObjId);
|
||||
if ObjId<0 then
|
||||
@ -384,7 +404,7 @@ begin
|
||||
Result:=JOBResult_Success;
|
||||
end;
|
||||
|
||||
function TJOBBridge.GetStringResult(ResultP: NativeInt): TJOBResult;
|
||||
function TJSObjectBridge.GetStringResult(ResultP: NativeInt): TJOBResult;
|
||||
var
|
||||
View: TJSDataView;
|
||||
l, i: SizeInt;
|
||||
@ -398,19 +418,45 @@ begin
|
||||
FStringResult:='';
|
||||
end;
|
||||
|
||||
function TJOBBridge.ReleaseStringResult: TJOBResult;
|
||||
function TJSObjectBridge.ReleaseStringResult: TJOBResult;
|
||||
begin
|
||||
Result:=JOBResult_Success;
|
||||
FStringResult:='';
|
||||
end;
|
||||
|
||||
function TJOBBridge.GetInvokeArguments(View: TJSDataView; ArgsP: NativeInt
|
||||
function TJSObjectBridge.GetInvokeArguments(View: TJSDataView; ArgsP: NativeInt
|
||||
): TJSValueDynArray;
|
||||
type
|
||||
TProxyFunc = reference to function: jsvalue;
|
||||
var
|
||||
p: NativeInt;
|
||||
|
||||
function ReadWasmNativeInt: TWasmNativeInt;
|
||||
begin
|
||||
Result:=View.getUint32(p,env.IsLittleEndian);
|
||||
inc(p,4);
|
||||
end;
|
||||
|
||||
function GetArgMethod: TProxyFunc;
|
||||
var
|
||||
aCall, aData, aCode: TWasmNativeInt;
|
||||
begin
|
||||
aCall:=ReadWasmNativeInt;
|
||||
aData:=ReadWasmNativeInt;
|
||||
aCode:=ReadWasmNativeInt;
|
||||
Result:=function: jsvalue
|
||||
var Args: TWasmNativeInt;
|
||||
begin
|
||||
writeln('TJSObjectBridge called Method Call=',aCall,' Data=',aData,' Code=',aCode,' Args=',JSArguments.length);
|
||||
Args:=CreateCallbackArgs(View,JSArguments);
|
||||
Result:=CallbackHandler(aCall,aData,aCode,Args);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
Cnt, aType: Byte;
|
||||
i: Integer;
|
||||
p: NativeInt;
|
||||
Len, Ptr: LongWord;
|
||||
Len, Ptr: TWasmNativeInt;
|
||||
aBytes: TJSUint8Array;
|
||||
aWords: TJSUint16Array;
|
||||
ObjID: LongInt;
|
||||
@ -424,7 +470,7 @@ begin
|
||||
aType:=View.getUInt8(p);
|
||||
inc(p);
|
||||
case aType of
|
||||
JOBArgNone:
|
||||
JOBArgUndefined:
|
||||
Result[i]:=Undefined;
|
||||
JOBArgLongint:
|
||||
begin
|
||||
@ -447,39 +493,33 @@ begin
|
||||
end;
|
||||
JOBArgUTF8String:
|
||||
begin
|
||||
Len:=View.getUint32(p,env.IsLittleEndian);
|
||||
inc(p,4);
|
||||
Ptr:=View.getUint32(p,env.IsLittleEndian);
|
||||
inc(p,4);
|
||||
Len:=ReadWasmNativeInt;
|
||||
Ptr:=ReadWasmNativeInt;
|
||||
aBytes:=TJSUint8Array.New(View.buffer, Ptr,Len);
|
||||
Result[i]:=TypedArrayToString(aBytes);
|
||||
//writeln('TJOBBridge.GetInvokeArguments UTF8String="',Result[i],'"');
|
||||
end;
|
||||
JOBArgUnicodeString:
|
||||
begin
|
||||
Len:=View.getUint32(p,env.IsLittleEndian);
|
||||
inc(p,4);
|
||||
Ptr:=View.getUint32(p,env.IsLittleEndian);
|
||||
inc(p,4);
|
||||
Len:=ReadWasmNativeInt;
|
||||
Ptr:=ReadWasmNativeInt;
|
||||
aWords:=TJSUint16Array.New(View.buffer, Ptr,Len);
|
||||
Result[i]:=TypedArrayToString(aWords);
|
||||
end;
|
||||
JOBArgNil:
|
||||
Result[i]:=nil;
|
||||
JOBArgPointer:
|
||||
begin
|
||||
Result[i]:=View.getUint32(p,env.IsLittleEndian);
|
||||
inc(p,4);
|
||||
end;
|
||||
Result[i]:=ReadWasmNativeInt;
|
||||
JOBArgObject:
|
||||
begin
|
||||
ObjID:=View.getInt32(p,env.IsLittleEndian);
|
||||
inc(p,4);
|
||||
ObjID:=ReadWasmNativeInt;
|
||||
Obj:=FindObject(ObjID);
|
||||
if Obj=nil then
|
||||
raise Exception.Create('invalid JSObject'+IntToStr(ObjID));
|
||||
Result[i]:=Obj;
|
||||
end;
|
||||
JOBArgMethod:
|
||||
Result[i]:=GetArgMethod;
|
||||
else
|
||||
raise Exception.Create('unknown arg type '+IntToStr(aType));
|
||||
end;
|
||||
@ -487,7 +527,87 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJOBBridge.GetJOBResult(v: jsvalue): TJOBResult;
|
||||
function TJSObjectBridge.CreateCallbackArgs(View: TJSDataView;
|
||||
const Args: TJSFunctionArguments): TWasmNativeInt;
|
||||
var
|
||||
i, Len, j: Integer;
|
||||
Arg: JSValue;
|
||||
r: TJOBResult;
|
||||
s: String;
|
||||
NewId: TJOBObjectID;
|
||||
p: LongWord;
|
||||
begin
|
||||
Result:=0;
|
||||
if Args.Length=0 then exit;
|
||||
if Args.Length>255 then
|
||||
raise Exception.Create('too many arguments');
|
||||
|
||||
// compute needed wasm memory
|
||||
Len:=1;
|
||||
for i:=0 to Args.Length-1 do
|
||||
begin
|
||||
Arg:=Args[i];
|
||||
r:=GetJOBResult(Arg);
|
||||
inc(Len);
|
||||
case r of
|
||||
JOBResult_Boolean: inc(Len);
|
||||
JOBResult_Double: inc(Len,8);
|
||||
JOBResult_String: inc(Len,4+2*TJSString(Arg).length);
|
||||
JOBResult_Function,
|
||||
JOBResult_Object: inc(Len,4);
|
||||
end;
|
||||
end;
|
||||
|
||||
// allocate wasm memory
|
||||
Result:=WasiExports.AllocMem(Len);
|
||||
|
||||
// write
|
||||
p:=Result;
|
||||
View.setUint8(p,Args.Length);
|
||||
inc(p);
|
||||
for i:=0 to Args.Length-1 do
|
||||
begin
|
||||
Arg:=Args[i];
|
||||
r:=GetJOBResult(Arg);
|
||||
View.setUint8(p,r);
|
||||
inc(p);
|
||||
case r of
|
||||
JOBResult_Boolean:
|
||||
begin
|
||||
if Arg then
|
||||
View.setUint8(p,1)
|
||||
else
|
||||
View.setUint8(p,0);
|
||||
inc(p);
|
||||
end;
|
||||
JOBResult_Double:
|
||||
begin
|
||||
View.setFloat64(p,double(Arg),env.IsLittleEndian);
|
||||
inc(p,8);
|
||||
end;
|
||||
JOBResult_String:
|
||||
begin
|
||||
s:=String(Arg);
|
||||
View.setUint32(p,length(s));
|
||||
inc(p,4);
|
||||
for j:=0 to length(s)-1 do
|
||||
begin
|
||||
View.setUint16(p,ord(s[j+1]),env.IsLittleEndian);
|
||||
inc(p,2);
|
||||
end;
|
||||
end;
|
||||
JOBResult_Function,
|
||||
JOBResult_Object:
|
||||
begin
|
||||
NewId:=RegisterLocalObject(TJSObject(Arg));
|
||||
View.setUint32(p, longword(NewId), env.IsLittleEndian);
|
||||
inc(p,4);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJSObjectBridge.GetJOBResult(v: jsvalue): TJOBResult;
|
||||
begin
|
||||
case jstypeof(v) of
|
||||
'undefined': Result:=JOBResult_Undefined;
|
||||
|
||||
@ -58,8 +58,9 @@ const
|
||||
JOBFn_InvokeObjectResult = 'invoke_objectresult';
|
||||
JOBFn_ReleaseObject = 'release_object';
|
||||
JOBFn_InvokeJSValueResult = 'invoke_jsvalueresult';
|
||||
JOBFn_CallbackHandler = 'JOBCallback';
|
||||
|
||||
JOBArgNone = 0;
|
||||
JOBArgUndefined = 0;
|
||||
JOBArgLongint = 1;
|
||||
JOBArgDouble = 2;
|
||||
JOBArgTrue = 3;
|
||||
@ -70,6 +71,22 @@ const
|
||||
JOBArgNil = 8;
|
||||
JOBArgPointer = 9;
|
||||
JOBArgObject = 10; // followed by ObjectID
|
||||
JOBArgMethod = 11; // followed by Callback, Data, Code
|
||||
|
||||
JOBArgNames: array[0..11] of string = (
|
||||
'Undefined',
|
||||
'Longint',
|
||||
'Double',
|
||||
'True',
|
||||
'False',
|
||||
'Char',
|
||||
'UTF8String',
|
||||
'UnicodeString',
|
||||
'Nil',
|
||||
'Pointer',
|
||||
'Object',
|
||||
'Method'
|
||||
);
|
||||
|
||||
JOBInvokeCall = 0; // call function
|
||||
JOBInvokeGet = 1; // read property
|
||||
|
||||
@ -21,6 +21,8 @@ const
|
||||
MaxSafeIntDouble = $1fffffffffffff; // 9007199254740991
|
||||
|
||||
Type
|
||||
PJOBObjectID = ^TJOBObjectID;
|
||||
|
||||
EJSObject = class(Exception);
|
||||
EJSInvoke = class(EJSObject)
|
||||
public
|
||||
@ -33,7 +35,8 @@ Type
|
||||
jjvkBoolean,
|
||||
jjvkDouble,
|
||||
jjvkString,
|
||||
jjvkObject
|
||||
jjvkObject,
|
||||
jivkMethod
|
||||
);
|
||||
TJOB_JSValueKinds = set of TJOB_JSValueKind;
|
||||
|
||||
@ -43,7 +46,8 @@ const
|
||||
'Boolean',
|
||||
'Double',
|
||||
'String',
|
||||
'Object'
|
||||
'Object',
|
||||
'Callback'
|
||||
);
|
||||
|
||||
JOB_Undefined = Pointer(1);
|
||||
@ -86,15 +90,28 @@ type
|
||||
function AsString: string; override;
|
||||
end;
|
||||
|
||||
PJOBObjectID = ^TJOBObjectID;
|
||||
TJOBInvokeOneResultFunc = function(
|
||||
ObjID: TJOBObjectID;
|
||||
NameP: PChar;
|
||||
NameLen: longint;
|
||||
Invoke: longint;
|
||||
ArgP: PByte;
|
||||
ResultP: PByte
|
||||
): TJOBResult;
|
||||
IJSObject = interface;
|
||||
|
||||
{ TJOB_JSValueObject }
|
||||
|
||||
TJOB_JSValueObject = class(TJOB_JSValue)
|
||||
public
|
||||
Value: IJSObject;
|
||||
constructor Create(aValue: IJSObject);
|
||||
function AsString: string; override;
|
||||
end;
|
||||
|
||||
TJOBCallback = function(const aMethod: TMethod; Args: NativeInt): TJOB_JSValue;
|
||||
|
||||
{ TJOB_JSValueMethod }
|
||||
|
||||
TJOB_JSValueMethod = class(TJOB_JSValue)
|
||||
public
|
||||
Value: TMethod;
|
||||
Invoke: TJOBCallback;
|
||||
constructor Create(const aMethod: TMethod; const AnInvoke: TJOBCallback);
|
||||
function AsString: string; override;
|
||||
end;
|
||||
|
||||
TJOBInvokeGetType = (
|
||||
jigCall, // call function
|
||||
@ -114,6 +131,7 @@ type
|
||||
IJSObject = interface
|
||||
['{BE5CDE03-D471-4AB3-8F27-A5EA637416F7}']
|
||||
function GetJSObjectID: TJOBObjectID;
|
||||
function GetJSObjectCasted: IJSObject;
|
||||
function GetPascalClassName: string;
|
||||
procedure InvokeJSNoResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeSetType = jisCall); virtual;
|
||||
function InvokeJSBooleanResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeGetType = jigCall): Boolean; virtual;
|
||||
@ -139,22 +157,24 @@ type
|
||||
function NewJSObject(Const Args: Array of const; aResultClass: TJSObjectClass): TJSObject; virtual;
|
||||
end;
|
||||
|
||||
{ TJOB_JSValueObject }
|
||||
|
||||
TJOB_JSValueObject = class(TJOB_JSValue)
|
||||
public
|
||||
Value: IJSObject;
|
||||
constructor Create(aValue: IJSObject);
|
||||
function AsString: string; override;
|
||||
end;
|
||||
|
||||
{ TJSObject }
|
||||
|
||||
TJSObject = class(TInterfacedObject,IJSObject)
|
||||
private
|
||||
FObjectID: TJOBObjectID;
|
||||
FCasted: IJSObject;
|
||||
protected
|
||||
type
|
||||
TJOBInvokeOneResultFunc = function(
|
||||
ObjID: TJOBObjectID;
|
||||
NameP: PChar;
|
||||
NameLen: longint;
|
||||
Invoke: longint;
|
||||
ArgP: PByte;
|
||||
ResultP: PByte
|
||||
): TJOBResult;
|
||||
function GetJSObjectID: TJOBObjectID;
|
||||
function GetJSObjectCasted: IJSObject;
|
||||
function GetPascalClassName: string;
|
||||
function FetchString(Len: NativeInt): UnicodeString;
|
||||
function InvokeJSOneResult(const aName: string; Const Args: Array of const;
|
||||
@ -164,9 +184,11 @@ type
|
||||
procedure InvokeJS_RaiseResultMismatchStr(const aName: string; const Expected, Actual: string); virtual;
|
||||
function CreateInvokeJSArgs(const Args: array of const): PByte; virtual;
|
||||
public
|
||||
constructor Cast(Intf: IJSObject);
|
||||
constructor CreateFromID(aID: TJOBObjectID); virtual;
|
||||
destructor Destroy; override;
|
||||
property ObjectID: TJOBObjectID read FObjectID;
|
||||
// call a function
|
||||
procedure InvokeJSNoResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeSetType = jisCall); virtual;
|
||||
function InvokeJSBooleanResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeGetType = jigCall): Boolean; virtual;
|
||||
function InvokeJSDoubleResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeGetType = jigCall): Double; virtual;
|
||||
@ -175,6 +197,7 @@ type
|
||||
function InvokeJSValueResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeGetType = jigCall): TJOB_JSValue; virtual;
|
||||
function InvokeJSUtf8StringResult(const aName: string; Const args: Array of const; Invoke: TJOBInvokeGetType = jigCall): String; virtual;
|
||||
function InvokeJSLongIntResult(const aName: string; Const args: Array of const; Invoke: TJOBInvokeGetType = jigCall): LongInt; virtual;
|
||||
// read a property
|
||||
function ReadJSPropertyBoolean(const aName: string): boolean; virtual;
|
||||
function ReadJSPropertyDouble(const aName: string): double; virtual;
|
||||
function ReadJSPropertyUnicodeString(const aName: string): UnicodeString; virtual;
|
||||
@ -182,12 +205,15 @@ type
|
||||
function ReadJSPropertyUtf8String(const aName: string): string; virtual;
|
||||
function ReadJSPropertyLongInt(const aName: string): LongInt; virtual;
|
||||
function ReadJSPropertyValue(const aName: string): TJOB_JSValue; virtual;
|
||||
// write a property
|
||||
procedure WriteJSPropertyBoolean(const aName: string; Value: Boolean); virtual;
|
||||
procedure WriteJSPropertyDouble(const aName: string; Value: Double); virtual;
|
||||
procedure WriteJSPropertyUnicodeString(const aName: string; const Value: UnicodeString); virtual;
|
||||
procedure WriteJSPropertyUtf8String(const aName: string; const Value: String); virtual;
|
||||
procedure WriteJSPropertyObject(const aName: string; Value: TJSObject); virtual;
|
||||
procedure WriteJSPropertyLongInt(const aName: string; Value: LongInt); virtual;
|
||||
procedure WriteJSPropertyValue(const aName: string; Value: TJOB_JSValue); virtual;
|
||||
// create a new object using the new-operator
|
||||
function NewJSObject(Const Args: Array of const; aResultClass: TJSObjectClass): TJSObject; virtual;
|
||||
end;
|
||||
|
||||
@ -259,6 +285,8 @@ function __job_invoke_jsvalueresult(
|
||||
ResultP: PByte // various
|
||||
): TJOBResult; external JOBExportName name JOBFn_InvokeJSValueResult;
|
||||
|
||||
function MyCallBack(ObjID: TJOBObjectID): boolean;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
@ -308,6 +336,27 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
// exported function
|
||||
function MyCallBack(ObjID: TJOBObjectID): boolean; //public; alias: JOBFn_CallbackHandler;
|
||||
begin
|
||||
Result:=ObjID>0;
|
||||
end;
|
||||
|
||||
{ TJOB_JSValueMethod }
|
||||
|
||||
constructor TJOB_JSValueMethod.Create(const aMethod: TMethod;
|
||||
const AnInvoke: TJOBCallback);
|
||||
begin
|
||||
Kind:=jivkMethod;
|
||||
Value:=aMethod;
|
||||
Invoke:=AnInvoke;
|
||||
end;
|
||||
|
||||
function TJOB_JSValueMethod.AsString: string;
|
||||
begin
|
||||
Result:='Callback';
|
||||
end;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
{ TJOB_JSValue }
|
||||
@ -319,12 +368,11 @@ end;
|
||||
|
||||
function TJOB_JSValue.AsString: string;
|
||||
begin
|
||||
case Kind of
|
||||
jjvkUndefined: Result:='undefined';
|
||||
jjvkBoolean: ;
|
||||
jjvkDouble: ;
|
||||
jjvkString: ;
|
||||
jjvkObject: ;
|
||||
if Kind=jjvkUndefined then
|
||||
Result:='undefined'
|
||||
else begin
|
||||
Result:='';
|
||||
str(Kind,Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -390,6 +438,11 @@ begin
|
||||
Result:=FObjectID;
|
||||
end;
|
||||
|
||||
function TJSObject.GetJSObjectCasted: IJSObject;
|
||||
begin
|
||||
Result:=FCasted;
|
||||
end;
|
||||
|
||||
function TJSObject.GetPascalClassName: string;
|
||||
begin
|
||||
Result:=ClassName;
|
||||
@ -470,16 +523,84 @@ function TJSObject.CreateInvokeJSArgs(const Args: array of const): PByte;
|
||||
raise ERangeError.Create('Invoke js: number out of bounds');
|
||||
end;
|
||||
|
||||
var
|
||||
p: PByte;
|
||||
|
||||
procedure AddBoolean(b: boolean);
|
||||
begin
|
||||
if b then
|
||||
p^:=JOBArgTrue
|
||||
else
|
||||
p^:=JOBArgFalse;
|
||||
inc(p);
|
||||
end;
|
||||
|
||||
procedure AddDouble(const d: double);
|
||||
begin
|
||||
p^:=JOBArgDouble;
|
||||
inc(p);
|
||||
PDouble(p)^:=d;
|
||||
inc(p,8);
|
||||
end;
|
||||
|
||||
procedure AddChar(c: word);
|
||||
begin
|
||||
p^:=JOBArgChar;
|
||||
inc(p);
|
||||
PWord(p)^:=c;
|
||||
inc(p,2);
|
||||
end;
|
||||
|
||||
procedure AddObjectID(const ObjId: TJOBObjectID);
|
||||
begin
|
||||
p^:=JOBArgObject;
|
||||
inc(p);
|
||||
PNativeInt(p)^:=ObjId;
|
||||
inc(p,sizeof(NativeInt));
|
||||
end;
|
||||
|
||||
procedure AddIJSObject(const Intf: IJSObject);
|
||||
begin
|
||||
if Intf=nil then
|
||||
begin
|
||||
p^:=JOBArgNil;
|
||||
inc(p);
|
||||
end else
|
||||
AddObjectID(Intf.GetJSObjectID);
|
||||
end;
|
||||
|
||||
procedure AddUTF8String(s: PByte; Len: NativeInt);
|
||||
begin
|
||||
p^:=JOBArgUTF8String;
|
||||
inc(p);
|
||||
PNativeInt(p)^:=Len;
|
||||
inc(p,sizeof(NativeInt));
|
||||
PPointer(p)^:=s;
|
||||
inc(p,sizeof(Pointer));
|
||||
end;
|
||||
|
||||
procedure AddUnicodeString(s: PByte; Len: NativeInt);
|
||||
begin
|
||||
p^:=JOBArgUnicodeString;
|
||||
inc(p);
|
||||
PNativeInt(p)^:=Len;
|
||||
inc(p,sizeof(NativeInt));
|
||||
PPointer(p)^:=s;
|
||||
inc(p,sizeof(Pointer));
|
||||
end;
|
||||
|
||||
var
|
||||
i, Len: Integer;
|
||||
qw: QWord;
|
||||
i64: Int64;
|
||||
p, h: PByte;
|
||||
h: PByte;
|
||||
s: String;
|
||||
ws: WideString;
|
||||
us: UnicodeString;
|
||||
d: Double;
|
||||
Obj: TObject;
|
||||
JSValue: TJOB_JSValue;
|
||||
aMethod: TJOB_JSValueMethod;
|
||||
begin
|
||||
Result:=nil;
|
||||
if length(Args)>255 then
|
||||
@ -488,13 +609,14 @@ begin
|
||||
Len:=1;
|
||||
for i:=0 to high(Args) do
|
||||
begin
|
||||
writeln('TJSObject.CreateInvokeJSArgs ',i,' VType=',Args[i].VType);
|
||||
case Args[i].VType of
|
||||
vtInteger : inc(Len,5);
|
||||
vtBoolean : inc(Len);
|
||||
vtChar,
|
||||
vtWideChar : inc(Len,3);
|
||||
{$ifndef FPUNONE}
|
||||
vtExtended :
|
||||
vtExtended:
|
||||
begin
|
||||
d:=double(Args[i].VExtended^);
|
||||
if d=0 then ;
|
||||
@ -510,23 +632,44 @@ begin
|
||||
else
|
||||
inc(Len,1+SizeOf(PByte));
|
||||
end;
|
||||
vtPChar :
|
||||
vtPChar:
|
||||
begin
|
||||
// check length
|
||||
strlen(Args[i].VPChar);
|
||||
inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
|
||||
end;
|
||||
vtObject :
|
||||
vtObject:
|
||||
begin
|
||||
Obj:=Args[i].VObject;
|
||||
if Obj=nil then
|
||||
inc(Len,1)
|
||||
else if Obj is TJSObject then
|
||||
inc(Len,1+sizeof(TJOBObjectID))
|
||||
else if Obj is TJOB_JSValue then
|
||||
begin
|
||||
JSValue:=TJOB_JSValue(Obj);
|
||||
case JSValue.Kind of
|
||||
jjvkUndefined: inc(Len);
|
||||
jjvkBoolean: inc(Len);
|
||||
jjvkDouble: inc(Len,9);
|
||||
jjvkString: inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
|
||||
jjvkObject:
|
||||
if TJOB_JSValueObject(JSValue).Value=nil then
|
||||
inc(Len)
|
||||
else
|
||||
inc(Len,1+sizeof(TJOBObjectID));
|
||||
jivkMethod: inc(Len,1+3*SizeOf(PByte));
|
||||
end;
|
||||
end else
|
||||
RaiseNotSupported('object');
|
||||
end;
|
||||
vtClass : RaiseNotSupported('class');
|
||||
vtPWideChar : RaiseNotSupported('pwidechar');
|
||||
vtPWideChar:
|
||||
begin
|
||||
// check length
|
||||
strlen(Args[i].VPWideChar);
|
||||
inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
|
||||
end;
|
||||
vtAnsiString:
|
||||
inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
|
||||
vtCurrency : RaiseNotSupported('currency');
|
||||
@ -555,7 +698,8 @@ begin
|
||||
else
|
||||
inc(Len,9);
|
||||
end;
|
||||
vtUnicodeString : inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
|
||||
vtUnicodeString:
|
||||
inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
|
||||
vtQWord:
|
||||
begin
|
||||
qw:=Args[i].VQWord^;
|
||||
@ -584,54 +728,31 @@ begin
|
||||
inc(p,4);
|
||||
end;
|
||||
vtBoolean:
|
||||
begin
|
||||
if Args[i].VBoolean then
|
||||
p^:=JOBArgTrue
|
||||
else
|
||||
p^:=JOBArgFalse;
|
||||
inc(p);
|
||||
end;
|
||||
AddBoolean(Args[i].VBoolean);
|
||||
{$ifndef FPUNONE}
|
||||
vtExtended:
|
||||
begin
|
||||
p^:=JOBArgDouble;
|
||||
inc(p);
|
||||
PDouble(p)^:=double(Args[i].VExtended^);
|
||||
inc(p,8);
|
||||
end;
|
||||
AddDouble(double(Args[i].VExtended^));
|
||||
{$endif}
|
||||
vtChar:
|
||||
begin
|
||||
p^:=JOBArgChar;
|
||||
inc(p);
|
||||
PWord(p)^:=ord(Args[i].VChar);
|
||||
inc(p,2);
|
||||
end;
|
||||
AddChar(ord(Args[i].VChar));
|
||||
vtWideChar:
|
||||
begin
|
||||
p^:=JOBArgChar;
|
||||
inc(p);
|
||||
PWord(p)^:=ord(Args[i].VWideChar);
|
||||
inc(p,2);
|
||||
end;
|
||||
AddChar(ord(Args[i].VWideChar));
|
||||
vtString:
|
||||
begin
|
||||
// shortstring
|
||||
p^:=JOBArgUTF8String;
|
||||
inc(p);
|
||||
h:=PByte(Args[i].VString);
|
||||
PNativeInt(p)^:=h^;
|
||||
inc(h);
|
||||
inc(p,sizeof(NativeInt));
|
||||
PPointer(p)^:=h;
|
||||
inc(p,sizeof(Pointer));
|
||||
AddUTF8String(h+1,h^);
|
||||
end;
|
||||
vtPointer:
|
||||
begin
|
||||
h:=Args[i].VPointer;
|
||||
if h=JOB_Undefined then
|
||||
if h=nil then
|
||||
begin
|
||||
p^:=JOBArgNone;
|
||||
p^:=JOBArgNil;
|
||||
inc(p);
|
||||
end else if h=JOB_Undefined then
|
||||
begin
|
||||
p^:=JOBArgUndefined;
|
||||
inc(p);
|
||||
end
|
||||
else begin
|
||||
@ -643,13 +764,8 @@ begin
|
||||
end;
|
||||
vtPChar:
|
||||
begin
|
||||
p^:=JOBArgUTF8String;
|
||||
inc(p);
|
||||
h:=PByte(Args[i].VPChar);
|
||||
PNativeInt(p)^:=strlen(PChar(h));
|
||||
inc(p,sizeof(NativeInt));
|
||||
PPointer(p)^:=h;
|
||||
inc(p,sizeof(Pointer));
|
||||
AddUTF8String(h,strlen(PChar(h)));
|
||||
end;
|
||||
vtObject:
|
||||
begin
|
||||
@ -658,25 +774,56 @@ begin
|
||||
begin
|
||||
p^:=JOBArgNil;
|
||||
inc(p);
|
||||
end else begin
|
||||
p^:=JOBArgObject;
|
||||
inc(p);
|
||||
PNativeInt(p)^:=TJSObject(Obj).ObjectID;
|
||||
inc(p,sizeof(NativeInt));
|
||||
end;
|
||||
end;
|
||||
vtClass : ;
|
||||
vtPWideChar : ;
|
||||
vtAnsiString :
|
||||
end else if Obj is TJSObject then
|
||||
AddObjectID(TJSObject(Obj).ObjectID)
|
||||
else if Obj is TJOB_JSValue then
|
||||
begin
|
||||
p^:=JOBArgUTF8String;
|
||||
JSValue:=TJOB_JSValue(Obj);
|
||||
case JSValue.Kind of
|
||||
jjvkUndefined:
|
||||
begin
|
||||
p^:=JOBArgUndefined;
|
||||
inc(Len);
|
||||
end;
|
||||
jjvkBoolean:
|
||||
AddBoolean(TJOB_JSValueBoolean(Obj).Value);
|
||||
jjvkDouble:
|
||||
AddDouble(TJOB_JSValueDouble(Obj).Value);
|
||||
jjvkString:
|
||||
begin
|
||||
us:=TJOB_JSValueString(Obj).Value;
|
||||
h:=PByte(PWideChar(us));
|
||||
AddUnicodeString(h,length(us));
|
||||
end;
|
||||
jjvkObject:
|
||||
AddIJSObject(TJOB_JSValueObject(Obj).Value);
|
||||
jivkMethod:
|
||||
begin
|
||||
aMethod:=TJOB_JSValueMethod(Obj);
|
||||
p^:=JOBArgMethod;
|
||||
inc(p);
|
||||
PPointer(p)^:=Pointer(aMethod.Invoke);
|
||||
inc(p,sizeof(Pointer));
|
||||
PPointer(p)^:=aMethod.Value.Data;
|
||||
inc(p,sizeof(Pointer));
|
||||
PPointer(p)^:=aMethod.Value.Code;
|
||||
inc(p,sizeof(Pointer));
|
||||
end;
|
||||
end;
|
||||
end else
|
||||
RaiseNotSupported(Obj.ClassName);
|
||||
end;
|
||||
vtClass: ;
|
||||
vtPWideChar:
|
||||
begin
|
||||
h:=PByte(Args[i].VPWideChar);
|
||||
AddUnicodeString(h,strlen(PWideChar(h)));
|
||||
end;
|
||||
vtAnsiString:
|
||||
begin
|
||||
h:=Args[i].VAnsiString;
|
||||
s:=AnsiString(h);
|
||||
PNativeInt(p)^:=length(s);
|
||||
inc(p,sizeof(NativeInt));
|
||||
PPointer(p)^:=h;
|
||||
inc(p,sizeof(Pointer));
|
||||
AddUTF8String(h,length(s));
|
||||
end;
|
||||
vtCurrency : ;
|
||||
{$ifdef FPC_HAS_FEATURE_VARIANTS}
|
||||
@ -690,22 +837,14 @@ begin
|
||||
p^:=JOBArgNil;
|
||||
inc(p);
|
||||
end else begin
|
||||
p^:=JOBArgObject;
|
||||
inc(p);
|
||||
PNativeInt(p)^:=IJSObject(h).GetJSObjectID;
|
||||
inc(p,sizeof(NativeInt));
|
||||
AddIJSObject(IJSObject(h));
|
||||
end;
|
||||
end;
|
||||
vtWideString:
|
||||
begin
|
||||
p^:=JOBArgUnicodeString;
|
||||
inc(p);
|
||||
h:=Args[i].VWideString;
|
||||
ws:=WideString(h);
|
||||
PNativeInt(p)^:=length(ws);
|
||||
inc(p,sizeof(NativeInt));
|
||||
PPointer(p)^:=h;
|
||||
inc(p,sizeof(Pointer));
|
||||
AddUnicodeString(h,length(ws));
|
||||
end;
|
||||
vtInt64:
|
||||
begin
|
||||
@ -725,14 +864,9 @@ begin
|
||||
end;
|
||||
vtUnicodeString:
|
||||
begin
|
||||
p^:=JOBArgUnicodeString;
|
||||
inc(p);
|
||||
h:=Args[i].VUnicodeString;
|
||||
us:=UnicodeString(h);
|
||||
PNativeInt(p)^:=length(us);
|
||||
inc(p,sizeof(NativeInt));
|
||||
PPointer(p)^:=h;
|
||||
inc(p,sizeof(Pointer));
|
||||
AddUnicodeString(h,length(us));
|
||||
end;
|
||||
vtQWord:
|
||||
begin
|
||||
@ -765,6 +899,14 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
constructor TJSObject.Cast(Intf: IJSObject);
|
||||
begin
|
||||
FObjectID:=Intf.GetJSObjectID;
|
||||
FCasted:=Intf.GetJSObjectCasted;
|
||||
if FCasted=nil then
|
||||
FCasted:=Intf;
|
||||
end;
|
||||
|
||||
constructor TJSObject.CreateFromID(aID: TJOBObjectID);
|
||||
begin
|
||||
FObjectID:=aID;
|
||||
@ -772,8 +914,11 @@ end;
|
||||
|
||||
destructor TJSObject.Destroy;
|
||||
begin
|
||||
if ObjectID>=0 then
|
||||
if FCasted<>nil then
|
||||
FCasted:=nil
|
||||
else if ObjectID>=0 then
|
||||
__job_release_object(ObjectID);
|
||||
FObjectID:=0;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -976,6 +1121,12 @@ begin
|
||||
InvokeJSNoResult(aName,[Value],jisSetter);
|
||||
end;
|
||||
|
||||
procedure TJSObject.WriteJSPropertyValue(const aName: string;
|
||||
Value: TJOB_JSValue);
|
||||
begin
|
||||
InvokeJSNoResult(aName,[Value],jisSetter);
|
||||
end;
|
||||
|
||||
function TJSObject.NewJSObject(const Args: array of const;
|
||||
aResultClass: TJSObjectClass): TJSObject;
|
||||
begin
|
||||
|
||||
@ -9,10 +9,26 @@ uses
|
||||
Classes, SysUtils, JOB_Shared, JOB_WAsm;
|
||||
|
||||
type
|
||||
IJSEvent = interface;
|
||||
|
||||
IEventListenerEvent = IJSEvent;
|
||||
|
||||
TJSEventHandler = function(Event: IEventListenerEvent): boolean of object;
|
||||
|
||||
IJSEventTarget = interface
|
||||
['{1883145B-C826-47D1-9C63-47546BA536BD}']
|
||||
procedure addEventListener(const aName: UnicodeString; const aListener: TJSEventHandler);
|
||||
end;
|
||||
|
||||
{ TJSEventTarget }
|
||||
|
||||
TJSEventTarget = class(TJSObject,IJSEventTarget)
|
||||
procedure addEventListener(const aName: UnicodeString; const aListener: TJSEventHandler);
|
||||
end;
|
||||
|
||||
{ IJSNode }
|
||||
|
||||
IJSNode = interface(IJSObject)
|
||||
IJSNode = interface(IJSEventTarget)
|
||||
['{D7A751A8-73AD-4620-B2EE-03165A9D65D7}']
|
||||
function GetInnerText: UnicodeString;
|
||||
procedure SetInnerText(const AValue: UnicodeString);
|
||||
@ -21,8 +37,7 @@ type
|
||||
|
||||
{ TJSNode }
|
||||
|
||||
TJSNode = class(TJSObject,IJSNode)
|
||||
public
|
||||
TJSNode = class(TJSEventTarget,IJSNode)
|
||||
function GetInnerText: UnicodeString;
|
||||
procedure SetInnerText(const AValue: UnicodeString);
|
||||
end;
|
||||
@ -57,17 +72,7 @@ type
|
||||
procedure Set_ClassName(const AValue: UnicodeString);
|
||||
end;
|
||||
|
||||
IJSDocument = interface(IJSNode)
|
||||
['{CC3FB7C1-C4ED-4BBC-80AB-7B6C2989E026}']
|
||||
function getElementById(const aID : UnicodeString) : IJSElement;
|
||||
end;
|
||||
|
||||
{ TJSDocument }
|
||||
|
||||
TJSDocument = class(TJSNode,IJSDocument)
|
||||
public
|
||||
function getElementById(const aID : UnicodeString) : IJSElement;
|
||||
end;
|
||||
{ IJSEvent }
|
||||
|
||||
IJSEvent = interface(IJSObject)
|
||||
['{8B752F08-21F6-4F0D-B7A0-5A6616E752AD}']
|
||||
@ -78,26 +83,60 @@ type
|
||||
{ TJSEvent }
|
||||
|
||||
TJSEvent = class(TJSObject,IJSEvent)
|
||||
public
|
||||
function CurrentTargetElement: IJSElement;
|
||||
function TargetElement: IJSElement;
|
||||
end;
|
||||
|
||||
TEventListenerEvent = TJSEvent;
|
||||
IJSUIEvent = interface(IJSEvent)
|
||||
['{A1234998-5180-4905-B820-10FAB9B2DD12}']
|
||||
end;
|
||||
TJSUIEvent = class(TJSEvent,IJSUIEvent)
|
||||
end;
|
||||
|
||||
TJSEventHandler = reference to function(Event: TEventListenerEvent): boolean;
|
||||
IJSMouseEvent = interface(IJSUIEvent)
|
||||
['{B91DC727-1164-43AE-8481-55421D3148C4}']
|
||||
end;
|
||||
TJSMouseEvent = class(TJSUIEvent,IJSMouseEvent)
|
||||
end;
|
||||
|
||||
THTMLClickEventHandler = function(aEvent: IJSMouseEvent) : boolean of object;
|
||||
|
||||
{ IJSHTMLElement }
|
||||
|
||||
IJSHTMLElement = interface(IJSElement)
|
||||
['{D50E53E1-5B3B-4DA4-ACB0-1FD0DE32B711}']
|
||||
procedure set_onclick(const h: THTMLClickEventHandler);
|
||||
end;
|
||||
|
||||
{ TJSHTMLElement }
|
||||
|
||||
TJSHTMLElement = class(TJSElement,IJSHTMLElement)
|
||||
procedure set_onclick(const h: THTMLClickEventHandler);
|
||||
end;
|
||||
|
||||
IJSDocument = interface(IJSNode)
|
||||
['{CC3FB7C1-C4ED-4BBC-80AB-7B6C2989E026}']
|
||||
function getElementById(const aID : UnicodeString) : IJSElement;
|
||||
end;
|
||||
|
||||
{ TJSDocument }
|
||||
|
||||
TJSDocument = class(TJSNode,IJSDocument)
|
||||
function getElementById(const aID : UnicodeString) : IJSElement;
|
||||
end;
|
||||
|
||||
{ IJSWindow }
|
||||
|
||||
IJSWindow = interface(IJSObject)
|
||||
['{7DEBCDE5-2C6C-4758-9EE3-CF153AF2AFA0}']
|
||||
procedure AddEventListener(const aName: UnicodeString; const aListener: TJSEventHandler);
|
||||
procedure addEventListener(const aName: UnicodeString; const aListener: TJSEventHandler);
|
||||
procedure Alert(Const Msg: UnicodeString);
|
||||
end;
|
||||
|
||||
{ TJSWindow }
|
||||
|
||||
TJSWindow = class(TJSObject,IJSWindow)
|
||||
public
|
||||
procedure AddEventListener(const aName: UnicodeString; const aListener: TJSEventHandler);
|
||||
procedure addEventListener(const aName: UnicodeString; const aListener: TJSEventHandler);
|
||||
procedure Alert(Const Msg: UnicodeString);
|
||||
end;
|
||||
|
||||
@ -105,8 +144,58 @@ var
|
||||
JSDocument: TJSDocument;
|
||||
JSWindow: TJSWindow;
|
||||
|
||||
function JOBCallTHTMLClickEventHandler(const aMethod: TMethod; Args: NativeInt): TJOB_JSValue;
|
||||
function JOBCallTJSEventHandler(const aMethod: TMethod; Args: NativeInt): TJOB_JSValue;
|
||||
|
||||
implementation
|
||||
|
||||
function JOBCallTHTMLClickEventHandler(const aMethod: TMethod; Args: NativeInt
|
||||
): TJOB_JSValue;
|
||||
begin
|
||||
writeln('InvokeTHTMLClickEventHandler ');
|
||||
Result:=nil;
|
||||
if aMethod.Code=nil then ;
|
||||
if Args=0 then ;
|
||||
end;
|
||||
|
||||
function JOBCallTJSEventHandler(const aMethod: TMethod; Args: NativeInt
|
||||
): TJOB_JSValue;
|
||||
begin
|
||||
writeln('InvokeTJSEventHandler ');
|
||||
Result:=nil;
|
||||
if aMethod.Code=nil then ;
|
||||
if Args=0 then ;
|
||||
end;
|
||||
|
||||
{ TJSEventTarget }
|
||||
|
||||
procedure TJSEventTarget.addEventListener(const aName: UnicodeString;
|
||||
const aListener: TJSEventHandler);
|
||||
var
|
||||
cb1: TJOB_JSValueMethod;
|
||||
begin
|
||||
cb1:=TJOB_JSValueMethod.Create(TMethod(aListener),@JOBCallTJSEventHandler);
|
||||
try
|
||||
InvokeJSNoResult('addEventListener',[aName,cb1]);
|
||||
finally
|
||||
cb1.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TJSHTMLElement }
|
||||
|
||||
procedure TJSHTMLElement.set_onclick(const h: THTMLClickEventHandler);
|
||||
var
|
||||
cb1: TJOB_JSValueMethod;
|
||||
begin
|
||||
cb1:=TJOB_JSValueMethod.Create(TMethod(h),@JOBCallTHTMLClickEventHandler);
|
||||
try
|
||||
WriteJSPropertyValue('onclick',cb1);
|
||||
finally
|
||||
cb1.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TJSEvent }
|
||||
|
||||
function TJSEvent.CurrentTargetElement: IJSElement;
|
||||
@ -182,10 +271,17 @@ end;
|
||||
|
||||
{ TJSWindow }
|
||||
|
||||
procedure TJSWindow.AddEventListener(const aName: UnicodeString;
|
||||
procedure TJSWindow.addEventListener(const aName: UnicodeString;
|
||||
const aListener: TJSEventHandler);
|
||||
var
|
||||
cb1: TJOB_JSValueMethod;
|
||||
begin
|
||||
InvokeJSNoResult('addEventListener',[{Todo}]);
|
||||
cb1:=TJOB_JSValueMethod.Create(TMethod(aListener),@JOBCallTJSEventHandler);
|
||||
try
|
||||
InvokeJSNoResult('addEventListener',[aName,cb1]);
|
||||
finally
|
||||
cb1.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJSWindow.Alert(const Msg: UnicodeString);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user