From 32c19ae0ec3a6e3dc8a2fae0eea3bf987e42faeb Mon Sep 17 00:00:00 2001 From: mattias Date: Sat, 28 May 2022 22:15:07 +0200 Subject: [PATCH] wasi job: started callback --- .gitmodules | 4 - compiler | 1 - demo/wasienv/dom/BrowserDomTest1.lpr | 19 +- demo/wasienv/dom/WasiDomTest1.lpi | 3 + demo/wasienv/dom/WasiDomTest1.lpr | 119 +++++---- demo/wasienv/dom/index.html | 2 +- demo/wasienv/dom/job_browser.pp | 194 +++++++++++--- demo/wasienv/dom/job_shared.pp | 19 +- demo/wasienv/dom/job_wasm.pas | 361 +++++++++++++++++++-------- demo/wasienv/dom/job_web.pas | 140 +++++++++-- 10 files changed, 640 insertions(+), 222 deletions(-) delete mode 160000 compiler diff --git a/.gitmodules b/.gitmodules index 55cd279..e69de29 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,4 +0,0 @@ -[submodule "compiler"] - path = compiler - url = ../source - branch = main diff --git a/compiler b/compiler deleted file mode 160000 index 1dd80d5..0000000 --- a/compiler +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 1dd80d596d0f11601c6c834df19cc1916bf9ea6b diff --git a/demo/wasienv/dom/BrowserDomTest1.lpr b/demo/wasienv/dom/BrowserDomTest1.lpr index 3489dd5..9e29faa 100644 --- a/demo/wasienv/dom/BrowserDomTest1.lpr +++ b/demo/wasienv/dom/BrowserDomTest1.lpr @@ -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; diff --git a/demo/wasienv/dom/WasiDomTest1.lpi b/demo/wasienv/dom/WasiDomTest1.lpi index 371cdef..4fc4f04 100644 --- a/demo/wasienv/dom/WasiDomTest1.lpi +++ b/demo/wasienv/dom/WasiDomTest1.lpi @@ -62,6 +62,9 @@ + + + diff --git a/demo/wasienv/dom/WasiDomTest1.lpr b/demo/wasienv/dom/WasiDomTest1.lpr index 246c7b2..1ec741f 100644 --- a/demo/wasienv/dom/WasiDomTest1.lpr +++ b/demo/wasienv/dom/WasiDomTest1.lpr @@ -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. diff --git a/demo/wasienv/dom/index.html b/demo/wasienv/dom/index.html index 91d5b03..d2d309b 100644 --- a/demo/wasienv/dom/index.html +++ b/demo/wasienv/dom/index.html @@ -26,7 +26,7 @@

Test Area

-
+
Playground

Console output

diff --git a/demo/wasienv/dom/job_browser.pp b/demo/wasienv/dom/job_browser.pp index 5866b6c..2fd3e21 100644 --- a/demo/wasienv/dom/job_browser.pp +++ b/demo/wasienv/dom/job_browser.pp @@ -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; diff --git a/demo/wasienv/dom/job_shared.pp b/demo/wasienv/dom/job_shared.pp index 6dd5d39..a8008fc 100644 --- a/demo/wasienv/dom/job_shared.pp +++ b/demo/wasienv/dom/job_shared.pp @@ -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 diff --git a/demo/wasienv/dom/job_wasm.pas b/demo/wasienv/dom/job_wasm.pas index c5c275a..4a9aba7 100644 --- a/demo/wasienv/dom/job_wasm.pas +++ b/demo/wasienv/dom/job_wasm.pas @@ -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 + 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 else if Obj is TJSObject then + AddObjectID(TJSObject(Obj).ObjectID) + else if Obj is TJOB_JSValue then + begin + 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 : ; - vtAnsiString : + vtClass: ; + vtPWideChar: + begin + h:=PByte(Args[i].VPWideChar); + AddUnicodeString(h,strlen(PWideChar(h))); + end; + vtAnsiString: begin - p^:=JOBArgUTF8String; - inc(p); 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 diff --git a/demo/wasienv/dom/job_web.pas b/demo/wasienv/dom/job_web.pas index 482eaf1..9470291 100644 --- a/demo/wasienv/dom/job_web.pas +++ b/demo/wasienv/dom/job_web.pas @@ -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);