Home Explore Help
Sign In
pascal
/
pas2js
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git
2
0
Fork 0
Files Issues 0 Wiki
Browse Source

job: added newoperator and started some base js classes

mattias 3 years ago
parent
afb933e39e
commit
f28dbe57cb
9 changed files with 499 additions and 55 deletions
Unified View Show Diff Stats
  1. 1 1
      demo/wasienv/dom/BrowserDomTest1.lpr
  2. 10 0
      demo/wasienv/dom/WasiDomTest1.lpi
  3. 13 2
      demo/wasienv/dom/WasiDomTest1.lpr
  4. 3 3
      demo/wasienv/dom/index.html
  5. 69 2
      demo/wasienv/dom/job_browser.pp
  6. 49 0
      demo/wasienv/dom/job_js.pas
  7. 28 4
      demo/wasienv/dom/job_shared.pp
  8. 123 43
      demo/wasienv/dom/job_wasm.pas
  9. 203 0
      demo/wasienv/dom/job_web.pas

+ 1 - 1
demo/wasienv/dom/BrowserDomTest1.lpr
View File 

@@ -146,7 +146,7 @@ begin
 
   FWasiEnv.OnStdOutputWrite:=@DoWrite;
 
   FWasiEnv.OnStdOutputWrite:=@DoWrite;
 
   FWADomBridge:=TJOBBridge.Create(FWasiEnv);
 
   FWADomBridge:=TJOBBridge.Create(FWasiEnv);
 
 
 
-  if FWADomBridge.RegisterGlobalObject(TJSObject(TBird.Create('Root')))<>WasiObjIdBird then
 
+  if FWADomBridge.RegisterGlobalObject(TJSObject(TBird.Create('Root')))<>JObjIdBird then
 
     raise Exception.Create('Root TBird wrong number');
 
     raise Exception.Create('Root TBird wrong number');
 
 end;
 
 end;

+ 10 - 0
demo/wasienv/dom/WasiDomTest1.lpi
View File 

@@ -33,6 +33,16 @@
 
         <IsPartOfProject Value="True"/>
 
         <IsPartOfProject Value="True"/>
 
         <UnitName Value="JOB_WAsm"/>
 
         <UnitName Value="JOB_WAsm"/>
 
       </Unit>
 
       </Unit>
 
+      <Unit>
 
+        <Filename Value="job_web.pas"/>
 
+        <IsPartOfProject Value="True"/>
 
+        <UnitName Value="JOB_Web"/>
 
+      </Unit>
 
+      <Unit>
 
+        <Filename Value="job_js.pas"/>
 
+        <IsPartOfProject Value="True"/>
 
+        <UnitName Value="JOB_JS"/>
 
+      </Unit>
 
     </Units>
 
     </Units>
 
   </ProjectOptions>
 
   </ProjectOptions>
 
   <CompilerOptions>
 
   <CompilerOptions>

+ 13 - 2
demo/wasienv/dom/WasiDomTest1.lpr
View File 

@@ -5,7 +5,7 @@ program WasiDomTest1;
 
 {$codepage UTF8}
 
 {$codepage UTF8}
 
 
 
 uses
 
 uses
 
-  SysUtils, JOB_WAsm, JOB_Shared;
 
+  SysUtils, JOB_WAsm, JOB_Shared, JOB_Web, JOB_JS;
 
 
 
 type
 
 type
 
 
 
@@ -76,8 +76,19 @@ var
 
   Freddy, Alice, aBird: TBird;
 
   Freddy, Alice, aBird: TBird;
 
   i: Integer;
 
   i: Integer;
 
   JSValue: TJOB_JSValue;
 
   JSValue: TJOB_JSValue;
 
+  JSElem: IJSElement;
 
+  aDate: IJSDate;
 
 begin
 
 begin
 
-  obj:=TJSObject.CreateFromID(WasiObjIdBird);
 
+  JSElem:=JSDocument.getElementById('playground');
 
+  writeln('Class=',JSElem._ClassName);
 
+
 
+  aDate:=JSDate.Create(2003,2,5,8,47,30,777);
 
+  u:=aDate.toLocaleDateString;
 
+  writeln('toLocaleDateString=',u);
 
+
 
+  exit;
 
+
 
+  obj:=TJSObject.CreateFromID(JObjIdBird);
 
   obj.WriteJSPropertyUnicodeString('Caption','Root');
 
   obj.WriteJSPropertyUnicodeString('Caption','Root');
 
   writeln('AAA1 ');
 
   writeln('AAA1 ');
 
   u:='äbc';
 
   u:='äbc';

+ 3 - 3
demo/wasienv/dom/index.html
View File 

@@ -4,7 +4,7 @@
 
 <head>
 
 <head>
 
   <meta http-equiv="Content-type" content="text/html; charset=utf-8">
 
   <meta http-equiv="Content-type" content="text/html; charset=utf-8">
 
   <meta name="viewport" content="width=device-width, initial-scale=1">
 
   <meta name="viewport" content="width=device-width, initial-scale=1">
 
-  <title>FPC-Webassembly accesing browser DOM through Pas2JS Demo</title>
 
+  <title>FPC-Webassembly accessing browser DOM through Pas2JS Demo</title>
 
   <link href="bulma.min.css" rel="stylesheet">
 
   <link href="bulma.min.css" rel="stylesheet">
 
   <script src="BrowserDomTest1.js"></script>
 
   <script src="BrowserDomTest1.js"></script>
 
   <style>
 
   <style>
 
@@ -25,8 +25,8 @@
 
 </head>
 
 </head>
 
 <body>
 
 <body>
 
   <div class="section py-4">
 
   <div class="section py-4">
 
-    <h1 class="title is-3">Canvas</h1>
 
-    <div class="box" id="canvases"></div>
 
+    <h1 class="title is-3">Test Area</h1>
 
+    <div class="box" id="playground"></div>
 
   </div>
 
   </div>
 
   <div class="section py-4">
 
   <div class="section py-4">
 
     <h1 class="title is-3">Console output</h1>
 
     <h1 class="title is-3">Console output</h1>

+ 69 - 2
demo/wasienv/dom/job_browser.pp
View File 

@@ -52,6 +52,39 @@ asm
 
   return String.fromCharCode.apply(null,a);
 
   return String.fromCharCode.apply(null,a);
 
 end;
 
 end;
 
 
 
+function NewObj(const fn: TJSFunction; const Args: TJSValueDynArray): TJSFunction; assembler;
 
+asm
 
+  if (Args == null){
 
+    return new fn();
 
+  }
 
+  var l = Args.length;
 
+  if (l==0){
 
+    return new fn();
 
+  } else if (l==1){
 
+    return new fn(Args[0]);
 
+  } else if (l==2){
 
+    return new fn(Args[0],Args[1]);
 
+  } else if (l==3){
 
+    return new fn(Args[0],Args[1],Args[2]);
 
+  } else if (l==4){
 
+    return new fn(Args[0],Args[1],Args[2],Args[3]);
 
+  } else if (l==5){
 
+    return new fn(Args[0],Args[1],Args[2],Args[3],Args[4]);
 
+  } else if (l==6){
 
+    return new fn(Args[0],Args[1],Args[2],Args[3],Args[4],Args[5]);
 
+  } else if (l==7){
 
+    return new fn(Args[0],Args[1],Args[2],Args[3],Args[4],Args[5],Args[6]);
 
+  } else if (l==8){
 
+    return new fn(Args[0],Args[1],Args[2],Args[3],Args[4],Args[5],Args[6],Args[7]);
 
+  } else if (l==9){
 
+    return new fn(Args[0],Args[1],Args[2],Args[3],Args[4],Args[5],Args[6],Args[7],Args[8]);
 
+  } else if (l==10){
 
+    return new fn(Args[0],Args[1],Args[2],Args[3],Args[4],Args[5],Args[6],Args[7],Args[8],Args[9]);
 
+  } else {
 
+    return null;
 
+  }
 
+end;
 
+
 
 constructor TJOBBridge.Create(aEnv: TPas2JSWASIEnvironment);
 
 constructor TJOBBridge.Create(aEnv: TPas2JSWASIEnvironment);
 
 begin
 
 begin
 
   Inherited Create(aEnv);
 
   Inherited Create(aEnv);
 
@@ -60,6 +93,22 @@ begin
 
   FGlobalObjects[-JOBObjIdWindow]:=window;
 
   FGlobalObjects[-JOBObjIdWindow]:=window;
 
   FGlobalObjects[-JOBObjIdConsole]:=console;
 
   FGlobalObjects[-JOBObjIdConsole]:=console;
 
   FGlobalObjects[-JOBObjIdCaches]:=caches;
 
   FGlobalObjects[-JOBObjIdCaches]:=caches;
 
+  FGlobalObjects[-JOBObjIdObject]:=TJSObject;
 
+  FGlobalObjects[-JOBObjIdFunction]:=TJSFunction;
 
+  FGlobalObjects[-JOBObjIdDate]:=TJSDate;
 
+  FGlobalObjects[-JOBObjIdString]:=TJSString;
 
+  FGlobalObjects[-JOBObjIdArray]:=TJSArray;
 
+  FGlobalObjects[-JOBObjIdArrayBuffer]:=TJSArrayBuffer;
 
+  FGlobalObjects[-JOBObjIdInt8Array]:=TJSInt8Array;
 
+  FGlobalObjects[-JOBObjIdUint8Array]:=TJSUint8Array;
 
+  FGlobalObjects[-JOBObjIdUint8ClampedArray]:=TJSUint8ClampedArray;
 
+  FGlobalObjects[-JOBObjIdInt16Array]:=TJSInt16Array;
 
+  FGlobalObjects[-JOBObjIdUint16Array]:=TJSUint16Array;
 
+  FGlobalObjects[-JOBObjIdInt32Array]:=TJSUint32Array;
 
+  FGlobalObjects[-JOBObjIdFloat32Array]:=TJSFloat32Array;
 
+  FGlobalObjects[-JOBObjIdFloat64Array]:=TJSFloat64Array;
 
+  FGlobalObjects[-JOBObjIdJSON]:=TJSJSON;
 
+  FGlobalObjects[-JOBObjIdPromise]:=TJSPromise;
 
   FLocalObjects:=TJSArray.new;
 
   FLocalObjects:=TJSArray.new;
 
   FFreeLocalIds:=TJSArray.new;
 
   FFreeLocalIds:=TJSArray.new;
 
 end;
 
 end;
 
@@ -149,13 +198,29 @@ begin
 
         JSResult:=TJSFunction(fn).apply(Obj,Args);
 
         JSResult:=TJSFunction(fn).apply(Obj,Args);
 
       end;
 
       end;
 
     end;
 
     end;
 
-  JOBInvokeGetter:
 
+  JOBInvokeNew:
 
+    begin
 
+      if PropName<>'' then
 
+        fn:=Obj[PropName]
 
+      else
 
+        fn:=Obj;
 
+      if jstypeof(fn)<>'function' then
 
+        exit(JOBResult_NotAFunction);
 
+
 
+      if ArgsP=0 then
 
+        JSResult:=NewObj(TJSFunction(fn),nil)
 
+      else begin
 
+        Args:=GetInvokeArguments(View,ArgsP);
 
+        JSResult:=NewObj(TJSFunction(fn),Args)
 
+      end;
 
+    end;
 
+  JOBInvokeGet:
 
     begin
 
     begin
 
       if ArgsP>0 then
 
       if ArgsP>0 then
 
         exit(JOBResult_WrongArgs);
 
         exit(JOBResult_WrongArgs);
 
       JSResult:=Obj[PropName];
 
       JSResult:=Obj[PropName];
 
     end;
 
     end;
 
-  JOBInvokeSetter:
 
+  JOBInvokeSet:
 
     begin
 
     begin
 
       JSResult:=Undefined;
 
       JSResult:=Undefined;
 
       if ArgsP=0 then
 
       if ArgsP=0 then
 
@@ -359,6 +424,8 @@ begin
 
     aType:=View.getUInt8(p);
 
     aType:=View.getUInt8(p);
 
     inc(p);
 
     inc(p);
 
     case aType of
 
     case aType of
 
+    JOBArgNone:
 
+      Result[i]:=Undefined;
 
     JOBArgLongint:
 
     JOBArgLongint:
 
       begin
 
       begin
 
         Result[i]:=View.getInt32(p,env.IsLittleEndian);
 
         Result[i]:=View.getInt32(p,env.IsLittleEndian);

+ 49 - 0
demo/wasienv/dom/job_js.pas
View File 

@@ -0,0 +1,49 @@
 
+unit JOB_JS;
 
+
 
+{$mode ObjFPC}{$H+}
 
+
 
+interface
 
+
 
+uses
 
+  JOB_Shared, JOB_WAsm;
 
+
 
+type
 
+  IJSDate = interface(IJSObject)
 
+    ['{F12818EA-542E-488C-A3C5-279E05639E9E}']
 
+    function toLocaleDateString: UnicodeString; overload; // date in locale timezone, no time
 
+  end;
 
+
 
+  { TJSDate }
 
+
 
+  TJSDate = class(TJSObject,IJSDate)
 
+  public
 
+    class function Create(aYear: NativeInt; aMonth: NativeInt; aDayOfMonth: NativeInt = 1;
 
+      TheHours: NativeInt = 0; TheMinutes: NativeInt = 0; TheSeconds: NativeInt = 0;
 
+      TheMilliseconds: NativeInt = 0): IJSDate;
 
+    function toLocaleDateString: UnicodeString; overload; // date in locale timezone, no time
 
+  end;
 
+
 
+var
 
+  JSDate: TJSDate;
 
+
 
+implementation
 
+
 
+{ TJSDate }
 
+
 
+class function TJSDate.Create(aYear: NativeInt; aMonth: NativeInt;
 
+  aDayOfMonth: NativeInt; TheHours: NativeInt; TheMinutes: NativeInt;
 
+  TheSeconds: NativeInt; TheMilliseconds: NativeInt): IJSDate;
 
+begin
 
+  Result:=JSDate.NewJSObject([aYear,aMonth,aDayOfMonth,TheHours,TheMinutes,TheSeconds,TheMilliseconds],TJSDate) as IJSDate;
 
+end;
 
+
 
+function TJSDate.toLocaleDateString: UnicodeString;
 
+begin
 
+  Result:=InvokeJSUnicodeStringResult('toLocaleDateString',[]);
 
+end;
 
+
 
+initialization
 
+  JSDate:=TJSDate.CreateFromID(JOBObjIdDate);
 
+
 
+end.
 
+

+ 28 - 4
demo/wasienv/dom/job_shared.pp
View File 

@@ -71,16 +71,40 @@ const
 
   JOBArgPointer = 9;
 
   JOBArgPointer = 9;
 
   JOBArgObject = 10; // followed by ObjectID
 
   JOBArgObject = 10; // followed by ObjectID
 
 
 
-  JOBInvokeCall = 0;
 
-  JOBInvokeGetter = 1;
 
-  JOBInvokeSetter = 2;
 
+  JOBInvokeCall = 0; // call function
 
+  JOBInvokeGet = 1; // read property
 
+  JOBInvokeSet = 2; // set property
 
+  JOBInvokeNew = 3; // new operator
 
+
 
+  JOBInvokeNames: array[0..3] of string = (
 
+    'Call',
 
+    'Get',
 
+    'Set',
 
+    'New'
 
+    );
 
 
 
   JOBObjIdDocument = -1;
 
   JOBObjIdDocument = -1;
 
   JOBObjIdWindow = -2;
 
   JOBObjIdWindow = -2;
 
   JOBObjIdConsole = -3;
 
   JOBObjIdConsole = -3;
 
   JOBObjIdCaches = -4;
 
   JOBObjIdCaches = -4;
 
+  JOBObjIdObject = -5;
 
+  JOBObjIdFunction = -6;
 
+  JOBObjIdDate = -7;
 
+  JOBObjIdString = -8;
 
+  JOBObjIdArray = -9;
 
+  JOBObjIdArrayBuffer = -10;
 
+  JOBObjIdInt8Array = -11;
 
+  JOBObjIdUint8Array = -12;
 
+  JOBObjIdUint8ClampedArray = -13;
 
+  JOBObjIdInt16Array = -13;
 
+  JOBObjIdUint16Array = -14;
 
+  JOBObjIdInt32Array = -16;
 
+  JOBObjIdFloat32Array = -17;
 
+  JOBObjIdFloat64Array = -18;
 
+  JOBObjIdJSON = -19;
 
+  JOBObjIdPromise = -20;
 
 
 
-  WasiObjIdBird = -5;
 
+  JObjIdBird = -21;
 
 
 
 implementation
 
 implementation

+ 123 - 43
demo/wasienv/dom/job_wasm.pas
View File 

@@ -46,6 +46,8 @@ const
 
     'Object'
 
     'Object'
 
     );
 
     );
 
 
 
+  JOB_Undefined = Pointer(1);
 
+
 
 type
 
 type
 
 
 
   { TJOB_JSValue }
 
   { TJOB_JSValue }
 
@@ -96,7 +98,8 @@ type
 
 
 
   TJOBInvokeGetType = (
 
   TJOBInvokeGetType = (
 
     jigCall,  // call function
 
     jigCall,  // call function
 
-    jigGetter // read property
 
+    jigGetter, // read property
 
+    jigNew // new operator
 
     );
 
     );
 
   TJOBInvokeSetType = (
 
   TJOBInvokeSetType = (
 
     jisCall,  // call function
 
     jisCall,  // call function
 
@@ -106,11 +109,34 @@ type
 
   TJSObject = class;
 
   TJSObject = class;
 
   TJSObjectClass = class of TJSObject;
 
   TJSObjectClass = class of TJSObject;
 
 
 
+  { IJSObject }
 
+
 
   IJSObject = interface
 
   IJSObject = interface
 
-    function GetObjectID: TJOBObjectID;
 
-    function GetClassName: string;
 
-    property ObjectID: TJOBObjectID read GetObjectID;
 
-    property ClassName: string read GetClassName;
 
+    ['{BE5CDE03-D471-4AB3-8F27-A5EA637416F7}']
 
+    function GetJSObjectID: TJOBObjectID;
 
+    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;
 
+    function InvokeJSDoubleResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeGetType = jigCall): Double; virtual;
 
+    function InvokeJSUnicodeStringResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeGetType = jigCall): UnicodeString; virtual;
 
+    function InvokeJSObjectResult(const aName: string; Const Args: Array of const; aResultClass: TJSObjectClass; Invoke: TJOBInvokeGetType = jigCall): TJSObject; virtual;
 
+    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;
 
+    function ReadJSPropertyBoolean(const aName: string): boolean; virtual;
 
+    function ReadJSPropertyDouble(const aName: string): double; virtual;
 
+    function ReadJSPropertyUnicodeString(const aName: string): UnicodeString; virtual;
 
+    function ReadJSPropertyObject(const aName: string; aResultClass: TJSObjectClass): TJSObject; virtual;
 
+    function ReadJSPropertyUtf8String(const aName: string): string; virtual;
 
+    function ReadJSPropertyLongInt(const aName: string): LongInt; virtual;
 
+    function ReadJSPropertyValue(const aName: string): TJOB_JSValue; virtual;
 
+    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;
 
+    function NewJSObject(Const Args: Array of const; aResultClass: TJSObjectClass): TJSObject; virtual;
 
   end;
 
   end;
 
 
 
   { TJOB_JSValueObject }
 
   { TJOB_JSValueObject }
 
@@ -128,8 +154,8 @@ type
 
   private
 
   private
 
     FObjectID: TJOBObjectID;
 
     FObjectID: TJOBObjectID;
 
   protected
 
   protected
 
-    function GetObjectID: TJOBObjectID;
 
-    function GetClassName: string;
 
+    function GetJSObjectID: TJOBObjectID;
 
+    function GetPascalClassName: string;
 
     function FetchString(Len: NativeInt): UnicodeString;
 
     function FetchString(Len: NativeInt): UnicodeString;
 
     function InvokeJSOneResult(const aName: string; Const Args: Array of const;
 
     function InvokeJSOneResult(const aName: string; Const Args: Array of const;
 
       const InvokeFunc: TJOBInvokeOneResultFunc; ResultP: PByte; Invoke: TJOBInvokeGetType): TJOBResult;
 
       const InvokeFunc: TJOBInvokeOneResultFunc; ResultP: PByte; Invoke: TJOBInvokeGetType): TJOBResult;
 
@@ -156,18 +182,19 @@ type
 
     function ReadJSPropertyUtf8String(const aName: string): string; virtual;
 
     function ReadJSPropertyUtf8String(const aName: string): string; virtual;
 
     function ReadJSPropertyLongInt(const aName: string): LongInt; virtual;
 
     function ReadJSPropertyLongInt(const aName: string): LongInt; virtual;
 
     function ReadJSPropertyValue(const aName: string): TJOB_JSValue; virtual;
 
     function ReadJSPropertyValue(const aName: string): TJOB_JSValue; virtual;
 
-    // ToDo: get JSValue property
 
     procedure WriteJSPropertyBoolean(const aName: string; Value: Boolean); virtual;
 
     procedure WriteJSPropertyBoolean(const aName: string; Value: Boolean); virtual;
 
     procedure WriteJSPropertyDouble(const aName: string; Value: Double); virtual;
 
     procedure WriteJSPropertyDouble(const aName: string; Value: Double); virtual;
 
     procedure WriteJSPropertyUnicodeString(const aName: string; const Value: UnicodeString); virtual;
 
     procedure WriteJSPropertyUnicodeString(const aName: string; const Value: UnicodeString); virtual;
 
     procedure WriteJSPropertyUtf8String(const aName: string; const Value: String); virtual;
 
     procedure WriteJSPropertyUtf8String(const aName: string; const Value: String); virtual;
 
     procedure WriteJSPropertyObject(const aName: string; Value: TJSObject); virtual;
 
     procedure WriteJSPropertyObject(const aName: string; Value: TJSObject); virtual;
 
     procedure WriteJSPropertyLongInt(const aName: string; Value: LongInt); virtual;
 
     procedure WriteJSPropertyLongInt(const aName: string; Value: LongInt); virtual;
 
+    function NewJSObject(Const Args: Array of const; aResultClass: TJSObjectClass): TJSObject; virtual;
 
   end;
 
   end;
 
 
 
 var
 
 var
 
-  JSDocument: TJSObject; // ToDo
 
+  JSObject: TJSObject;
 
 
 
+// imported functions from browser
 
 function __job_invoke_noresult(
 
 function __job_invoke_noresult(
 
   ObjID: TJOBObjectID;
 
   ObjID: TJOBObjectID;
 
   NameP: PChar;
 
   NameP: PChar;
 
@@ -182,7 +209,7 @@ function __job_invoke_boolresult(
 
   NameLen: longint;
 
   NameLen: longint;
 
   Invoke: longint;
 
   Invoke: longint;
 
   ArgP: PByte;
 
   ArgP: PByte;
 
-  ResultP: PByte // bytebool
 
+  ResultByteBoolP: PByte
 
 ): TJOBResult; external JOBExportName name JOBFn_InvokeBooleanResult;
 
 ): TJOBResult; external JOBExportName name JOBFn_InvokeBooleanResult;
 
 
 
 function __job_invoke_doubleresult(
 
 function __job_invoke_doubleresult(
 
@@ -191,7 +218,7 @@ function __job_invoke_doubleresult(
 
   NameLen: longint;
 
   NameLen: longint;
 
   Invoke: longint;
 
   Invoke: longint;
 
   ArgP: PByte;
 
   ArgP: PByte;
 
-  ResultP: PByte // double
 
+  ResultDoubleP: PByte
 
 ): TJOBResult; external JOBExportName name JOBFn_InvokeDoubleResult;
 
 ): TJOBResult; external JOBExportName name JOBFn_InvokeDoubleResult;
 
 
 
 function __job_invoke_stringresult(
 
 function __job_invoke_stringresult(
 
@@ -200,7 +227,7 @@ function __job_invoke_stringresult(
 
   NameLen: longint;
 
   NameLen: longint;
 
   Invoke: longint;
 
   Invoke: longint;
 
   ArgP: PByte;
 
   ArgP: PByte;
 
-  ResultLenP: PByte // length
 
+  ResultLenP: PByte // nativeint
 
 ): TJOBResult; external JOBExportName name JOBFn_InvokeStringResult;
 
 ): TJOBResult; external JOBExportName name JOBFn_InvokeStringResult;
 
 
 
 function __job_getstringresult(
 
 function __job_getstringresult(
 
@@ -216,7 +243,7 @@ function __job_invoke_objectresult(
 
   NameLen: longint;
 
   NameLen: longint;
 
   Invoke: longint;
 
   Invoke: longint;
 
   ArgP: PByte;
 
   ArgP: PByte;
 
-  ResultP: PByte // nativeint
 
+  ResultObjIDP: PByte // nativeint
 
 ): TJOBResult; external JOBExportName name JOBFn_InvokeObjectResult;
 
 ): TJOBResult; external JOBExportName name JOBFn_InvokeObjectResult;
 
 
 
 function __job_release_object(
 
 function __job_release_object(
 
@@ -229,7 +256,7 @@ function __job_invoke_jsvalueresult(
 
   NameLen: longint;
 
   NameLen: longint;
 
   Invoke: longint;
 
   Invoke: longint;
 
   ArgP: PByte;
 
   ArgP: PByte;
 
-  ResultP: PByte
 
+  ResultP: PByte  // various
 
 ): TJOBResult; external JOBExportName name JOBFn_InvokeJSValueResult;
 
 ): TJOBResult; external JOBExportName name JOBFn_InvokeJSValueResult;
 
 
 
 implementation
 
 implementation
 
@@ -237,11 +264,12 @@ implementation
 
 const
 
 const
 
   InvokeGetToInt: array[TJOBInvokeGetType] of integer = (
 
   InvokeGetToInt: array[TJOBInvokeGetType] of integer = (
 
     JOBInvokeCall,
 
     JOBInvokeCall,
 
-    JOBInvokeGetter
 
+    JOBInvokeGet,
 
+    JOBInvokeNew
 
     );
 
     );
 
   InvokeSetToInt: array[TJOBInvokeSetType] of integer = (
 
   InvokeSetToInt: array[TJOBInvokeSetType] of integer = (
 
     JOBInvokeCall,
 
     JOBInvokeCall,
 
-    JOBInvokeSetter
 
+    JOBInvokeSet
 
     );
 
     );
 
 
 
 {$IFDEF VerboseJOB}
 
 {$IFDEF VerboseJOB}
 
@@ -273,6 +301,13 @@ begin
 
     Result:='vt?';
 
     Result:='vt?';
 
   end;
 
   end;
 
 end;
 
 end;
 
+
 
+function __job_callback(w: NativeInt): boolean;
 
+begin
 
+  writeln('__job_callback w=',w);
 
+  Result:=true;
 
+end;
 
+
 
 {$ENDIF}
 
 {$ENDIF}
 
 
 
 { TJOB_JSValue }
 
 { TJOB_JSValue }
 
@@ -345,17 +380,17 @@ begin
 
   if Value=nil then
 
   if Value=nil then
 
     Result:='nil'
 
     Result:='nil'
 
   else
 
   else
 
-    Result:='['+IntToStr(Value.ObjectID)+']:'+Value.ClassName;
 
+    Result:='['+IntToStr(Value.GetJSObjectID)+']:'+Value.GetPascalClassName;
 
 end;
 
 end;
 
 
 
 { TJSObject }
 
 { TJSObject }
 
 
 
-function TJSObject.GetObjectID: TJOBObjectID;
 
+function TJSObject.GetJSObjectID: TJOBObjectID;
 
 begin
 
 begin
 
   Result:=FObjectID;
 
   Result:=FObjectID;
 
 end;
 
 end;
 
 
 
-function TJSObject.GetClassName: string;
 
+function TJSObject.GetPascalClassName: string;
 
 begin
 
 begin
 
   Result:=ClassName;
 
   Result:=ClassName;
 
 end;
 
 end;
 
@@ -467,7 +502,14 @@ begin
 
       end;
 
       end;
 
     {$endif}
 
     {$endif}
 
     vtString        : inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
 
     vtString        : inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
 
-    vtPointer,
 
+    vtPointer:
 
+      begin
 
+        p:=Args[i].VPointer;
 
+        if p=JOB_Undefined then
 
+          inc(Len)
 
+        else
 
+          inc(Len,1+SizeOf(PByte));
 
+      end;
 
     vtPChar         :
 
     vtPChar         :
 
       begin
 
       begin
 
         strlen(Args[i].VPChar);
 
         strlen(Args[i].VPChar);
 
@@ -485,14 +527,25 @@ begin
 
       end;
 
       end;
 
     vtClass         : RaiseNotSupported('class');
 
     vtClass         : RaiseNotSupported('class');
 
     vtPWideChar     : RaiseNotSupported('pwidechar');
 
     vtPWideChar     : RaiseNotSupported('pwidechar');
 
-    vtAnsiString    : inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
 
+    vtAnsiString:
 
+      inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
 
     vtCurrency      : RaiseNotSupported('currency');
 
     vtCurrency      : RaiseNotSupported('currency');
 
     {$ifdef FPC_HAS_FEATURE_VARIANTS}
 
     {$ifdef FPC_HAS_FEATURE_VARIANTS}
 
     vtVariant       : RaiseNotSupported('variant');
 
     vtVariant       : RaiseNotSupported('variant');
 
     {$endif FPC_HAS_FEATURE_VARIANTS}
 
     {$endif FPC_HAS_FEATURE_VARIANTS}
 
-    vtInterface     : RaiseNotSupported('interface');
 
-    vtWideString    : inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
 
-    vtInt64         :
 
+    vtInterface:
 
+      begin
 
+        p:=Args[i].VInterface;
 
+        if p=nil then
 
+          inc(Len,1)
 
+        else if IInterface(p) is IJSObject then
 
+          inc(Len,1+sizeof(TJOBObjectID))
 
+        else
 
+          RaiseNotSupported('interface');
 
+      end;
 
+    vtWideString:
 
+      inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
 
+    vtInt64:
 
       begin
 
       begin
 
         i64:=Args[i].VInt64^;
 
         i64:=Args[i].VInt64^;
 
         if (i64<MinSafeIntDouble) or (i64>MaxSafeIntDouble) then
 
         if (i64<MinSafeIntDouble) or (i64>MaxSafeIntDouble) then
 
@@ -503,7 +556,7 @@ begin
 
           inc(Len,9);
 
           inc(Len,9);
 
       end;
 
       end;
 
     vtUnicodeString : inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
 
     vtUnicodeString : inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
 
-    vtQWord         :
 
+    vtQWord:
 
       begin
 
       begin
 
         qw:=Args[i].VQWord^;
 
         qw:=Args[i].VQWord^;
 
         if (qw>MaxSafeIntDouble) then
 
         if (qw>MaxSafeIntDouble) then
 
@@ -523,14 +576,14 @@ begin
 
   for i:=0 to high(Args) do
 
   for i:=0 to high(Args) do
 
   begin
 
   begin
 
     case Args[i].VType of
 
     case Args[i].VType of
 
-    vtInteger       :
 
+    vtInteger:
 
       begin
 
       begin
 
         p^:=JOBArgLongint;
 
         p^:=JOBArgLongint;
 
         inc(p);
 
         inc(p);
 
         PLongint(p)^:=Args[i].VInteger;
 
         PLongint(p)^:=Args[i].VInteger;
 
         inc(p,4);
 
         inc(p,4);
 
       end;
 
       end;
 
-    vtBoolean       :
 
+    vtBoolean:
 
       begin
 
       begin
 
         if Args[i].VBoolean then
 
         if Args[i].VBoolean then
 
           p^:=JOBArgTrue
 
           p^:=JOBArgTrue
 
@@ -539,7 +592,7 @@ begin
 
         inc(p);
 
         inc(p);
 
       end;
 
       end;
 
     {$ifndef FPUNONE}
 
     {$ifndef FPUNONE}
 
-    vtExtended      :
 
+    vtExtended:
 
       begin
 
       begin
 
         p^:=JOBArgDouble;
 
         p^:=JOBArgDouble;
 
         inc(p);
 
         inc(p);
 
@@ -554,14 +607,14 @@ begin
 
         PWord(p)^:=ord(Args[i].VChar);
 
         PWord(p)^:=ord(Args[i].VChar);
 
         inc(p,2);
 
         inc(p,2);
 
       end;
 
       end;
 
-    vtWideChar      :
 
+    vtWideChar:
 
       begin
 
       begin
 
         p^:=JOBArgChar;
 
         p^:=JOBArgChar;
 
         inc(p);
 
         inc(p);
 
         PWord(p)^:=ord(Args[i].VWideChar);
 
         PWord(p)^:=ord(Args[i].VWideChar);
 
         inc(p,2);
 
         inc(p,2);
 
       end;
 
       end;
 
-    vtString        :
 
+    vtString:
 
       begin
 
       begin
 
         // shortstring
 
         // shortstring
 
         p^:=JOBArgUTF8String;
 
         p^:=JOBArgUTF8String;
 
@@ -575,12 +628,20 @@ begin
 
       end;
 
       end;
 
     vtPointer:
 
     vtPointer:
 
       begin
 
       begin
 
-        p^:=JOBArgPointer;
 
-        inc(p);
 
-        PPointer(p)^:=Args[i].VPointer;
 
-        inc(p,sizeof(Pointer));
 
+        h:=Args[i].VPointer;
 
+        if h=JOB_Undefined then
 
+        begin
 
+          p^:=JOBArgNone;
 
+          inc(p);
 
+        end
 
+        else begin
 
+          p^:=JOBArgPointer;
 
+          inc(p);
 
+          PPointer(p)^:=h;
 
+          inc(p,sizeof(Pointer));
 
+        end;
 
       end;
 
       end;
 
-    vtPChar         :
 
+    vtPChar:
 
       begin
 
       begin
 
         p^:=JOBArgUTF8String;
 
         p^:=JOBArgUTF8String;
 
         inc(p);
 
         inc(p);
 
@@ -590,7 +651,7 @@ begin
 
         PPointer(p)^:=h;
 
         PPointer(p)^:=h;
 
         inc(p,sizeof(Pointer));
 
         inc(p,sizeof(Pointer));
 
       end;
 
       end;
 
-    vtObject        :
 
+    vtObject:
 
       begin
 
       begin
 
         Obj:=Args[i].VObject;
 
         Obj:=Args[i].VObject;
 
         if Obj=nil then
 
         if Obj=nil then
 
@@ -600,7 +661,7 @@ begin
 
         end else begin
 
         end else begin
 
           p^:=JOBArgObject;
 
           p^:=JOBArgObject;
 
           inc(p);
 
           inc(p);
 
-          PNativeInt(p)^:=TJSObject(Args[i].VObject).ObjectID;
 
+          PNativeInt(p)^:=TJSObject(Obj).ObjectID;
 
           inc(p,sizeof(NativeInt));
 
           inc(p,sizeof(NativeInt));
 
         end;
 
         end;
 
       end;
 
       end;
 
@@ -621,8 +682,21 @@ begin
 
     {$ifdef FPC_HAS_FEATURE_VARIANTS}
 
     {$ifdef FPC_HAS_FEATURE_VARIANTS}
 
     vtVariant       : ;
 
     vtVariant       : ;
 
     {$endif FPC_HAS_FEATURE_VARIANTS}
 
     {$endif FPC_HAS_FEATURE_VARIANTS}
 
-    vtInterface     : ;
 
-    vtWideString    :
 
+    vtInterface:
 
+      begin
 
+        h:=Args[i].VInterface;
 
+        if h=nil then
 
+        begin
 
+          p^:=JOBArgNil;
 
+          inc(p);
 
+        end else begin
 
+          p^:=JOBArgObject;
 
+          inc(p);
 
+          PNativeInt(p)^:=IJSObject(h).GetJSObjectID;
 
+          inc(p,sizeof(NativeInt));
 
+        end;
 
+      end;
 
+    vtWideString:
 
       begin
 
       begin
 
         p^:=JOBArgUnicodeString;
 
         p^:=JOBArgUnicodeString;
 
         inc(p);
 
         inc(p);
 
@@ -633,7 +707,7 @@ begin
 
         PPointer(p)^:=h;
 
         PPointer(p)^:=h;
 
         inc(p,sizeof(Pointer));
 
         inc(p,sizeof(Pointer));
 
       end;
 
       end;
 
-    vtInt64         :
 
+    vtInt64:
 
       begin
 
       begin
 
         i64:=Args[i].VInt64^;
 
         i64:=Args[i].VInt64^;
 
         if (i64>=low(longint)) and (i64<=high(longint)) then
 
         if (i64>=low(longint)) and (i64<=high(longint)) then
 
@@ -649,7 +723,7 @@ begin
 
           inc(p,8);
 
           inc(p,8);
 
         end;
 
         end;
 
       end;
 
       end;
 
-    vtUnicodeString :
 
+    vtUnicodeString:
 
       begin
 
       begin
 
         p^:=JOBArgUnicodeString;
 
         p^:=JOBArgUnicodeString;
 
         inc(p);
 
         inc(p);
 
@@ -660,7 +734,7 @@ begin
 
         PPointer(p)^:=h;
 
         PPointer(p)^:=h;
 
         inc(p,sizeof(Pointer));
 
         inc(p,sizeof(Pointer));
 
       end;
 
       end;
 
-    vtQWord         :
 
+    vtQWord:
 
       begin
 
       begin
 
         qw:=Args[i].VQWord^;
 
         qw:=Args[i].VQWord^;
 
         if (qw<=high(longint)) then
 
         if (qw<=high(longint)) then
 
@@ -902,8 +976,14 @@ begin
 
   InvokeJSNoResult(aName,[Value],jisSetter);
 
   InvokeJSNoResult(aName,[Value],jisSetter);
 
 end;
 
 end;
 
 
 
+function TJSObject.NewJSObject(const Args: array of const;
 
+  aResultClass: TJSObjectClass): TJSObject;
 
+begin
 
+  Result:=InvokeJSObjectResult('',Args,aResultClass,jigNew);
 
+end;
 
+
 
 initialization
 
 initialization
 
-  JSDocument:=TJSObject.CreateFromID(JOBObjIdDocument);
 
+  JSObject:=TJSObject.CreateFromID(JOBObjIdObject);
 
 
 
 end.
 
 end.

+ 203 - 0
demo/wasienv/dom/job_web.pas
View File 

@@ -0,0 +1,203 @@
 
+unit JOB_Web;
 
+
 
+{$mode ObjFPC}{$H+}
 
+{$ModeSwitch FunctionReferences}
 
+
 
+interface
 
+
 
+uses
 
+  Classes, SysUtils, JOB_Shared, JOB_WAsm;
 
+
 
+type
 
+
 
+  { IJSNode }
 
+
 
+  IJSNode = interface(IJSObject)
 
+    ['{D7A751A8-73AD-4620-B2EE-03165A9D65D7}']
 
+    function GetInnerText: UnicodeString;
 
+    procedure SetInnerText(const AValue: UnicodeString);
 
+    property InnerText : UnicodeString read GetInnerText write SetInnerText;
 
+  end;
 
+
 
+  { TJSNode }
 
+
 
+  TJSNode = class(TJSObject,IJSNode)
 
+  public
 
+    function GetInnerText: UnicodeString;
 
+    procedure SetInnerText(const AValue: UnicodeString);
 
+  end;
 
+
 
+  { IJSElement }
 
+
 
+  IJSElement = interface(IJSNode)
 
+    ['{A160069E-378F-4B76-BE64-1979A28B9EEA}']
 
+    function childElementCount : Integer;
 
+    function firstElementChild : IJSElement;
 
+    function GetInnerHTML: UnicodeString;
 
+    function GetName: UnicodeString;
 
+    function Get_ClassName: UnicodeString;
 
+    procedure SetInnerHTML(const AValue: UnicodeString);
 
+    procedure SetName(const AValue: UnicodeString);
 
+    procedure Set_ClassName(const AValue: UnicodeString);
 
+    property Name: UnicodeString read GetName write SetName;
 
+    property _ClassName: UnicodeString read Get_ClassName write Set_ClassName;
 
+    property InnerHTML: UnicodeString read GetInnerHTML write SetInnerHTML;
 
+  end;
 
+
 
+  { TJSElement }
 
+
 
+  TJSElement = class(TJSNode,IJSElement)
 
+    function childElementCount : Integer;
 
+    function firstElementChild : IJSElement;
 
+    function GetInnerHTML: UnicodeString;
 
+    function GetName: UnicodeString;
 
+    function Get_ClassName: UnicodeString;
 
+    procedure SetInnerHTML(const AValue: UnicodeString);
 
+    procedure SetName(const AValue: UnicodeString);
 
+    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 = interface(IJSObject)
 
+    ['{8B752F08-21F6-4F0D-B7A0-5A6616E752AD}']
 
+    function CurrentTargetElement: IJSElement;
 
+    function TargetElement: IJSElement;
 
+  end;
 
+
 
+  { TJSEvent }
 
+
 
+  TJSEvent = class(TJSObject,IJSEvent)
 
+  public
 
+    function CurrentTargetElement: IJSElement;
 
+    function TargetElement: IJSElement;
 
+  end;
 
+
 
+  TEventListenerEvent = TJSEvent;
 
+
 
+  TJSEventHandler = reference to function(Event: TEventListenerEvent): boolean;
 
+
 
+  IJSWindow = interface(IJSObject)
 
+    ['{7DEBCDE5-2C6C-4758-9EE3-CF153AF2AFA0}']
 
+    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 Alert(Const Msg: UnicodeString);
 
+  end;
 
+
 
+var
 
+  JSDocument: TJSDocument;
 
+  JSWindow: TJSWindow;
 
+
 
+implementation
 
+
 
+{ TJSEvent }
 
+
 
+function TJSEvent.CurrentTargetElement: IJSElement;
 
+begin
 
+  Result:=ReadJSPropertyObject('currentTargetElement',TJSElement) as IJSElement;
 
+end;
 
+
 
+function TJSEvent.TargetElement: IJSElement;
 
+begin
 
+  Result:=ReadJSPropertyObject('targetElement',TJSElement) as IJSElement;
 
+end;
 
+
 
+{ TJSNode }
 
+
 
+function TJSNode.GetInnerText: UnicodeString;
 
+begin
 
+  Result:=ReadJSPropertyUnicodeString('innerText');
 
+end;
 
+
 
+procedure TJSNode.SetInnerText(const AValue: UnicodeString);
 
+begin
 
+  WriteJSPropertyUnicodeString('innerText',AValue);
 
+end;
 
+
 
+{ TJSElement }
 
+
 
+function TJSElement.childElementCount: Integer;
 
+begin
 
+  Result:=ReadJSPropertyLongInt('childElementCount');
 
+end;
 
+
 
+function TJSElement.firstElementChild: IJSElement;
 
+begin
 
+  Result:=ReadJSPropertyObject('firstElementChild',TJSElement) as IJSElement;
 
+end;
 
+
 
+function TJSElement.GetInnerHTML: UnicodeString;
 
+begin
 
+  Result:=ReadJSPropertyUnicodeString('innerHTML');
 
+end;
 
+
 
+function TJSElement.GetName: UnicodeString;
 
+begin
 
+  Result:=ReadJSPropertyUnicodeString('name');
 
+end;
 
+
 
+function TJSElement.Get_ClassName: UnicodeString;
 
+begin
 
+  Result:=ReadJSPropertyUnicodeString('className');
 
+end;
 
+
 
+procedure TJSElement.SetInnerHTML(const AValue: UnicodeString);
 
+begin
 
+  WriteJSPropertyUnicodeString('innerHTML',AValue);
 
+end;
 
+
 
+procedure TJSElement.SetName(const AValue: UnicodeString);
 
+begin
 
+  WriteJSPropertyUnicodeString('name',AValue);
 
+end;
 
+
 
+procedure TJSElement.Set_ClassName(const AValue: UnicodeString);
 
+begin
 
+  WriteJSPropertyUnicodeString('className',AValue);
 
+end;
 
+
 
+{ TJSDocument }
 
+
 
+function TJSDocument.getElementById(const aID: UnicodeString): IJSElement;
 
+begin
 
+  Result:=InvokeJSObjectResult('getElementById',[aID],TJSElement) as IJSElement;
 
+end;
 
+
 
+{ TJSWindow }
 
+
 
+procedure TJSWindow.AddEventListener(const aName: UnicodeString;
 
+  const aListener: TJSEventHandler);
 
+begin
 
+  InvokeJSNoResult('addEventListener',[{Todo}]);
 
+end;
 
+
 
+procedure TJSWindow.Alert(const Msg: UnicodeString);
 
+begin
 
+  InvokeJSNoResult('alert',[Msg]);
 
+end;
 
+
 
+initialization
 
+  JSDocument:=TJSDocument.CreateFromID(JOBObjIdDocument);
 
+  JSWindow:=TJSWindow.CreateFromID(JOBObjIdWindow);
 
+finalization
 
+  JSDocument.Free;
 
+  JSWindow.Free;
 
+end.
 
+