|
|
@@ -0,0 +1,134 @@
|
|
|
+library promisedemo;
|
|
|
+{$mode objfpc}
|
|
|
+{$h+}
|
|
|
+uses nothreads, sysutils, job.js, variants;
|
|
|
+
|
|
|
+Type
|
|
|
+ TFunction = function (const arguments: Variant): Variant of object;
|
|
|
+
|
|
|
+ IJSWindow = interface(IJSObject)
|
|
|
+ function setTimeout(const aHandler: TFunction; aTimeout: LongInt; const aArguments: Variant): LongInt{; ToDo:varargs};
|
|
|
+ function setTimeout(const aHandler: TFunction): LongInt{; ToDo:varargs};
|
|
|
+ function setTimeout(const aHandler: UnicodeString; aTimeout: LongInt; const aUnused: Variant): LongInt{; ToDo:varargs};
|
|
|
+ function setTimeout(const aHandler: UnicodeString): LongInt{; ToDo:varargs};
|
|
|
+ end;
|
|
|
+
|
|
|
+ TJSWindow = class(TJSObject,IJSWindow)
|
|
|
+ function setTimeout(const aHandler: TFunction; aTimeout: LongInt; const aArguments: Variant): LongInt{; ToDo:varargs};
|
|
|
+ function setTimeout(const aHandler: TFunction): LongInt{; ToDo:varargs};
|
|
|
+ function setTimeout(const aHandler: UnicodeString; aTimeout: LongInt; const aUnused: Variant): LongInt{; ToDo:varargs};
|
|
|
+ function setTimeout(const aHandler: UnicodeString): LongInt{; ToDo:varargs};
|
|
|
+ end;
|
|
|
+
|
|
|
+ TApp = Class(TObject)
|
|
|
+ private
|
|
|
+ FOnResolve: TJSPromiseResolver;
|
|
|
+ FOnReject: TJSPromiseResolver;
|
|
|
+ public
|
|
|
+ function DoTimeout(const arguments: Variant): Variant;
|
|
|
+ function DoResolve(const aValue: Variant): Variant;
|
|
|
+ procedure DoPromiseExecutor(const OnResolve, OnReject:TJSPromiseResolver);
|
|
|
+ function ResolveTest: TJSPromise;
|
|
|
+ procedure Run;
|
|
|
+ end;
|
|
|
+
|
|
|
+var
|
|
|
+ JSWindow : IJSWindow;
|
|
|
+
|
|
|
+function JOBCallFunction_(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte;
|
|
|
+var
|
|
|
+ arguments: Variant;
|
|
|
+begin
|
|
|
+ arguments:=H.GetVariant;
|
|
|
+ Result:=H.AllocVariant(TFunction(aMethod)(arguments));
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+function TJSWindow.setTimeout(const aHandler: TFunction; aTimeout: LongInt; const aArguments: Variant): LongInt{; ToDo:varargs};
|
|
|
+var
|
|
|
+ m: TJOB_Method;
|
|
|
+begin
|
|
|
+ m:=TJOB_Method.Create(TMethod(aHandler),@JOBCallFunction_);
|
|
|
+ try
|
|
|
+ Result:=InvokeJSLongIntResult('setTimeout',[m,aTimeout,aArguments]);
|
|
|
+ finally
|
|
|
+ m.free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+function TJSWindow.setTimeout(const aHandler: TFunction): LongInt{; ToDo:varargs};
|
|
|
+var
|
|
|
+ m: TJOB_Method;
|
|
|
+begin
|
|
|
+ m:=TJOB_Method.Create(TMethod(aHandler),@JOBCallFunction_);
|
|
|
+ try
|
|
|
+ Result:=InvokeJSLongIntResult('setTimeout',[m]);
|
|
|
+ finally
|
|
|
+ m.free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+function TJSWindow.setTimeout(const aHandler: UnicodeString; aTimeout: LongInt; const aUnused: Variant): LongInt{; ToDo:varargs};
|
|
|
+begin
|
|
|
+ Result:=InvokeJSLongIntResult('setTimeout',[aHandler,aTimeout,aUnused]);
|
|
|
+end;
|
|
|
+function TJSWindow.setTimeout(const aHandler: UnicodeString): LongInt{; ToDo:varargs};
|
|
|
+begin
|
|
|
+ Result:=InvokeJSLongIntResult('setTimeout',[aHandler]);
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+{ TApp }
|
|
|
+
|
|
|
+function TApp.DoTimeout(const arguments: Variant): Variant;
|
|
|
+begin
|
|
|
+ if not Assigned(FOnResolve) then
|
|
|
+ Writeln('Wasm ERROR: no resolve callback');
|
|
|
+ if not Assigned(FOnReject) then
|
|
|
+ Writeln('Wasm ERROR: no reject callback');
|
|
|
+
|
|
|
+ if Assigned(FOnResolve) then
|
|
|
+ FOnResolve('resolved');
|
|
|
+end;
|
|
|
+
|
|
|
+function TApp.DoResolve(const aValue: Variant): Variant;
|
|
|
+begin
|
|
|
+ Writeln('Wasm: in DoResolve: success. Argument vartype: ', vartype(aValue));
|
|
|
+ if vartype(aValue)=varOleStr then
|
|
|
+ Writeln('Wasm: DoResolve received value: ', VarToStr(aValue));
|
|
|
+ result:=unassigned;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TApp.DoPromiseExecutor(const OnResolve, OnReject: TJSPromiseResolver);
|
|
|
+begin
|
|
|
+ FOnResolve := OnResolve;
|
|
|
+ FOnReject := OnReject;
|
|
|
+
|
|
|
+ JSWindow.setTimeout(@DoTimeout, 1000, nil);
|
|
|
+end;
|
|
|
+
|
|
|
+function TApp.ResolveTest: TJSPromise;
|
|
|
+begin
|
|
|
+ Result:=TJSPromise.Create(@DoPromiseExecutor);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TApp.Run;
|
|
|
+
|
|
|
+Var
|
|
|
+ P : TJSPromise;
|
|
|
+
|
|
|
+begin
|
|
|
+ try
|
|
|
+ P:=ResolveTest;
|
|
|
+ P._then(@DoResolve);
|
|
|
+ except
|
|
|
+ on E: Exception do
|
|
|
+ Writeln(e.Message);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+var
|
|
|
+ App : TApp;
|
|
|
+begin
|
|
|
+ JSWindow:=TJSWindow.JOBCreateGlobal('window');
|
|
|
+ App:=TApp.Create;
|
|
|
+ App.Run;
|
|
|
+end.
|
Michaël Van Canneyt