paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-09-10 20:49:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

job: added invoke integer result

Browse Source
This commit is contained in:
mattias 2022-05-24 19:31:44 +02:00
parent 7093865f5b
commit 3dcd1d5d8b
5 changed files with 62 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
demo/wasienv/dom/BrowserDomTest1.lpr
View File

@ -15,11 +15,13 @@ Type
Name: string;
constructor Create(const aName: string); reintroduce;
procedure Proc;
function ArgsToStr(Args: TJSFunctionArguments): string;
published
function GetBoolean: boolean;
function GetDouble: double;
function GetString: string;
function GetInteger: integer;
function CreateChick(const aName: string): TBird;
function ArgsToStr(Args: TJSFunctionArguments): string;
end;
{ TMyApplication }
@ -52,6 +54,7 @@ begin
Proc;
GetBoolean;
GetDouble;
GetInteger;
GetString;
CreateChick('');
end;
@ -82,6 +85,12 @@ begin
Result:=Result+String(JSArguments[0]);
end;
function TBird.GetInteger: integer;
begin
writeln('TBird.GetInteger [',Name,'] ',ArgsToStr(JSArguments));
Result:=3000+JSArguments.Length;
end;
function TBird.CreateChick(const aName: string): TBird;
begin
writeln('TBird.CreateChick [',Name,'] ',ArgsToStr(JSArguments));

1
demo/wasienv/dom/WasiDomTest1.lpi
View File

@ -31,6 +31,7 @@
<Unit>
<Filename Value="job_wasm.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="JOB_WAsm"/>
</Unit>
</Units>
</ProjectOptions>

13
demo/wasienv/dom/WasiDomTest1.lpr
View File

@ -14,6 +14,7 @@ type
TBird = class(TJSObject)
public
function GetDouble: double;
function GetInteger: integer;
end;
{ TBird }
@ -23,11 +24,17 @@ begin
Result:=InvokeJSDoubleResult('GetDouble',[]);
end;
function TBird.GetInteger: integer;
begin
Result:=InvokeJSLongIntResult('GetInteger',[]);
end;
var
obj: TJSObject;
d: Double;
u: UnicodeString;
Freddy: TBird;
i: Integer;
begin
obj:=TJSObject.CreateFromID(WasiObjIdBird);
writeln('AAA1 ');
@ -36,14 +43,12 @@ begin
u:=obj.InvokeJSUnicodeStringResult('GetString',[u]);
writeln('AAA2 u="',u,'"');
exit;
//obj.InvokeJSNoResult('Proc',[]);
//d:=obj.InvokeJSDoubleResult('GetDouble',[u,12345678901]);
Freddy:=obj.InvokeJSObjResult('CreateChick',TBird,['Freddy']) as TBird;
writeln('AAA3 ');
d:=Freddy.GetDouble;
writeln('AAA4 ',d);
i:=Freddy.GetInteger;
writeln('AAA4 ',i);
Freddy.Free;
writeln('AAA5 ');
end.

10
demo/wasienv/dom/job_browser.pp
View File

@ -103,7 +103,7 @@ var
Obj: TJSObject;
fn: JSValue;
begin
writeln('TWADomBridge.Invoke_JSResult ObjId=',ObjId,' FuncNameP=',FuncNameP,' FuncNameLen=',FuncNameLen,' ArgsP=',ArgsP);
//writeln('TJOBBridge.Invoke_JSResult ObjId=',ObjId,' FuncNameP=',FuncNameP,' FuncNameLen=',FuncNameLen,' ArgsP=',ArgsP);
Obj:=FindObject(ObjId);
if Obj=nil then
@ -111,9 +111,9 @@ begin
View:=getModuleMemoryDataView();
aBytes:=TJSUint8Array.New(View.buffer, FuncNameP, FuncNameLen);
writeln('TWADomBridge.Invoke_JSResult aBytes=',aBytes);
//writeln('TJOBBridge.Invoke_JSResult aBytes=',aBytes);
FuncName:=TypedArrayToString(aBytes);
writeln('TWADomBridge.Invoke_JSResult FuncName="',FuncName,'"');
//writeln('TJOBBridge.Invoke_JSResult FuncName="',FuncName,'"');
fn:=Obj[FuncName];
if jstypeof(fn)<>'function' then
@ -227,7 +227,7 @@ end;
function TJOBBridge.ReleaseObject(ObjId: TJOBObjectID): TJOBResult;
begin
writeln('TWADomBridge.ReleaseObject ',ObjId);
//writeln('TJOBBridge.ReleaseObject ',ObjId);
if ObjId<0 then
raise EJOBBridge.Create('cannot release a global object');
if ObjId>=FLocalObjects.Length then
@ -322,7 +322,7 @@ begin
else
raise Exception.Create('unknown arg type '+IntToStr(aType));
end;
writeln('TWADomBridge.GetInvokeArguments ',i,'/',Cnt,' = ',Result[i]);
//writeln('TJOBBridge.GetInvokeArguments ',i,'/',Cnt,' = ',Result[i]);
end;
end;

46
demo/wasienv/dom/job_wasm.pas
View File

@ -50,18 +50,20 @@ Type
const InvokeFunc: TJOBInvokeOneResultFunc; ResultP: PByte): TJOBResult;
procedure InvokeRaise(const aName, Msg: string); virtual;
procedure InvokeRaiseResultMismatch(const aName: string; Expected, Actual: TJOBResult); virtual;
procedure InvokeRaiseResultMismatchStr(const aName: string; const Expected, Actual: string); virtual;
function CreateInvokeJSArgs(const Args: array of const): PByte; virtual;
public
constructor CreateFromID(aID: TJOBObjectID); virtual;
destructor Destroy; override;
property ObjectID: TJOBObjectID read FObjectID;
procedure InvokeJSNoResult(const aName: string; Const Args: Array of const);
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 InvokeJSObjResult(const aName: string; aResultClass: TJSObjectClass; Const args: Array of const): TJSObject;
procedure InvokeJSNoResult(const aName: string; Const Args: Array of const); virtual;
function InvokeJSBooleanResult(const aName: string; Const Args: Array of const): Boolean; virtual;
function InvokeJSDoubleResult(const aName: string; Const Args: Array of const): Double; virtual;
function InvokeJSUnicodeStringResult(const aName: string; Const Args: Array of const): UnicodeString; virtual;
function InvokeJSObjResult(const aName: string; aResultClass: TJSObjectClass; Const Args: Array of const): TJSObject; virtual;
// ToDo: InvokeJSVarRecResult
//function InvokeJSUtf8StringResult(const aName: string; Const args: Array of const): String;
function InvokeJSUtf8StringResult(const aName: string; Const args: Array of const): String; virtual;
function InvokeJSLongIntResult(const aName: string; Const args: Array of const): LongInt; virtual;
end;
var
@ -188,10 +190,16 @@ begin
JOBResult_UnknownObjId: InvokeRaise(aName,'unknown object id '+IntToStr(ObjectID));
JOBResult_NotAFunction: InvokeRaise(aName,'object '+IntToStr(ObjectID)+' does not have a function "'+aName+'"');
else
InvokeRaise(aName,'expected '+JOBResult_Names[Expected]+', but got '+JOBResult_Names[Actual]+' from object '+IntToStr(ObjectID)+' function "'+aName+'"');
InvokeRaiseResultMismatchStr(aName,JOBResult_Names[Expected],JOBResult_Names[Actual]);
end;
end;
procedure TJSObject.InvokeRaiseResultMismatchStr(const aName: string;
const Expected, Actual: string);
begin
InvokeRaise(aName,'expected '+Expected+', but got '+Actual+' from object '+IntToStr(ObjectID)+' function "'+aName+'"');
end;
function TJSObject.CreateInvokeJSArgs(const Args: array of const): PByte;
procedure RaiseNotSupported(const Msg: string);
@ -495,7 +503,7 @@ begin
end;
function TJSObject.InvokeJSUnicodeStringResult(const aName: string;
const args: array of const): UnicodeString;
const Args: array of const): UnicodeString;
var
ResultLen: NativeInt;
aError: TJOBResult;
@ -518,7 +526,7 @@ begin
end;
function TJSObject.InvokeJSObjResult(const aName: string;
aResultClass: TJSObjectClass; const args: array of const): TJSObject;
aResultClass: TJSObjectClass; const Args: array of const): TJSObject;
var
aError: TJOBResult;
NewObjId: TJOBObjectID;
@ -534,6 +542,26 @@ begin
Result:=aResultClass.CreateFromID(NewObjId);
end;
function TJSObject.InvokeJSUtf8StringResult(const aName: string;
const args: array of const): String;
begin
Result:=String(InvokeJSUnicodeStringResult(aName,Args));
end;
function TJSObject.InvokeJSLongIntResult(const aName: string;
const args: array of const): LongInt;
var
d: Double;
begin
d:=InvokeJSDoubleResult(aName,Args);
if Frac(d)<>0 then
InvokeRaiseResultMismatchStr(aName,'longint','double')
else if (d<low(longint)) or (d>high(longint)) then
InvokeRaiseResultMismatchStr(aName,'longint','double')
else
Result:=Trunc(d);
end;
initialization
JSDocument:=TJSObject.CreateFromID(JOBObjIdDocument);