mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-09-03 20:00:12 +02:00
* Add dynamic unit loader and demo
This commit is contained in:
michael
parent
45a382eef3
commit
a751522df8
@ -5,7 +5,7 @@ TARGETS=democomponents demobrowseconsole demoajax demoxhr restbridgeclient \
|
||||
chartjs_demoline chartjs_demotime chartjs_demoscriptablebubble chartjs_demoradar \
|
||||
chartjs_democustompoints chartjs_demopolararea promiseall promisestory1 \
|
||||
promisestory2 promisestory demodb demoload demorest fpcunitbrowsertest \
|
||||
sampleda webgl1 pdfbasic hotreload
|
||||
sampleda webgl1 pdfbasic hotreload dynload
|
||||
ifneq ($(SKIPWEBCOMPILER),1)
|
||||
TARGETS:=$(TARGETS) demowebcompiler
|
||||
BASEDIR=$(CURDIR)/../compiler/packages
|
||||
@ -14,83 +14,87 @@ COMPILERUNITPATH=$(BASEDIR)/compat;$(BASEDIR)/fcl-json/src;$(BASEDIR)/fcl-passrc
|
||||
endif
|
||||
|
||||
.PHONY: $(TARGETS)
|
||||
P2JS=pas2js
|
||||
P2JSOPT=-Fu../packages/\*
|
||||
P2JS=pas2js
|
||||
BROWSERP2JS=$(P2JS) $(P2JSOPT) -Jirtl.js -Jc -Tbrowser
|
||||
|
||||
all: $(TARGETS)
|
||||
|
||||
info:
|
||||
@echo Available targets: $(TARGETS)
|
||||
|
||||
democomponents: ./rtl/democomponents.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
|
||||
$(BROWSERP2JS) $<
|
||||
demobrowseconsole: ./rtl/demobrowserconsole.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
demoajax: ./rtl/demoajax.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
demoxhr: ./rtl/demoxhr.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
restbridgeclient: ./restbridge/simple/restbridgeclient.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
demowebcompiler: ./webcompiler/demowebcompiler.lpr
|
||||
$(P2JS) -Sc -TBrowser "-Fu$(COMPILERUNITPATH)" "-Fu$(COMPILERDIR)" $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) -Sc -TBrowser "-Fu$(COMPILERUNITPATH)" "-Fu$(COMPILERDIR)" $<
|
||||
fpreportdemo: ./fpreport/reportdemo.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demoprogressbar: ./chartjs/demoprogressbar.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demodate: ./chartjs/demodate.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demoscatter: ./chartjs/demoscatter.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demomixed: ./chartjs/demomixed.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demobar: ./chartjs/demobar.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demoarea: ./chartjs/demoarea.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demobubble: ./chartjs/demobubble.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demopie: ./chartjs/demopie.lpr
|
||||
$(P2JS) -Sc $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) -Sc $<
|
||||
chartjs_demodatalabelling: ./chartjs/demodatalabelling.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demodoughnut: ./chartjs/demodoughnut.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demointeractions: ./chartjs/demointeractions.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demoline: ./chartjs/demoline.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demotime: ./chartjs/demotime.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demoscriptablebubble: ./chartjs/demoscriptablebubble.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demoradar: ./chartjs/demoradar.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_democustompoints: ./chartjs/democustompoints.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
chartjs_demopolararea: ./chartjs/demopolararea.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
promiseall: ./promise/demoall.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
promisestory1: ./promise/story2.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
promisestory2: ./promise/story3.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
promisestory: ./promise/story.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
demodb: ./fcldb/demodb.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
demoload: ./fcldb/demoload.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
demorest: ./fcldb/demorest.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
fpcunitbrowsertest: ./fpcunit/browsertest.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
sampleda: ./dataabstract/sampleda.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
webgl1: ./webgl/project1.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
pdfbasic: ./jspdf/basic.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
hotreload: ./hotreload/hotreload.lpr
|
||||
$(P2JS) $(P2JSOPT) $<
|
||||
$(BROWSERP2JS) $<
|
||||
dynload: ./dynload/testloader.lpr ./dynload/myform.pp
|
||||
$(BROWSERP2JS) -OoRemoveNotUsedDeclarations- ./dynload/testloader.lpr
|
||||
$(P2JS) ./dynload/myform.pp
|
||||
|
||||
61
demo/dynload/FormFactory.pas
Normal file
61
demo/dynload/FormFactory.pas
Normal file
@ -0,0 +1,61 @@
|
||||
unit formfactory;
|
||||
|
||||
interface
|
||||
|
||||
uses classes;
|
||||
|
||||
Type
|
||||
TFormClass = Class of TComponent;
|
||||
|
||||
procedure RegisterForm(aClass: TFormClass);
|
||||
Function GetFormClassByName(const aName : String) : TFormClass;
|
||||
|
||||
implementation
|
||||
|
||||
uses sysutils, js;
|
||||
|
||||
Type
|
||||
TFormDef = Record
|
||||
aClass : TFormClass;
|
||||
aName : string;
|
||||
end;
|
||||
TFormDefArray = Array of TFormDef;
|
||||
|
||||
Var
|
||||
List : TFormDefArray;
|
||||
|
||||
procedure RegisterForm(aClass: TFormClass);
|
||||
|
||||
Var
|
||||
Def : TFormDef;
|
||||
|
||||
begin
|
||||
Def.aClass:=aClass;
|
||||
Def.aName:=aClass.ClassName;
|
||||
TJSArray(List).Push(JSValue(Def));
|
||||
end;
|
||||
|
||||
Function IndexOfFormClassByName(const aName : String) : Integer;
|
||||
|
||||
begin
|
||||
Result:=Length(List)-1;
|
||||
While (Result>=0) and Not SameText(aName,List[Result].aName) do
|
||||
Dec(Result);
|
||||
end;
|
||||
|
||||
Function GetFormClassByName(const aName : String) : TFormClass;
|
||||
|
||||
Var
|
||||
Idx: Integer;
|
||||
|
||||
begin
|
||||
Idx:=IndexOfFormClassByName(aName);
|
||||
if Idx=-1 then
|
||||
Result:=Nil
|
||||
else
|
||||
Result:=List[Idx].aClass;
|
||||
end;
|
||||
|
||||
initialization
|
||||
SetLength(List,0);
|
||||
end.
|
||||
19
demo/dynload/MyFormDep.pas
Normal file
19
demo/dynload/MyFormDep.pas
Normal file
@ -0,0 +1,19 @@
|
||||
unit MyFormDep;
|
||||
|
||||
interface
|
||||
|
||||
uses myformdep2;
|
||||
|
||||
Procedure DoLoaded;
|
||||
|
||||
implementation
|
||||
|
||||
Procedure DoLoaded;
|
||||
|
||||
begin
|
||||
Writeln('loaded');
|
||||
end;
|
||||
|
||||
initialization
|
||||
DoLoaded;
|
||||
end.
|
||||
27
demo/dynload/myform.pp
Normal file
27
demo/dynload/myform.pp
Normal file
@ -0,0 +1,27 @@
|
||||
unit myform;
|
||||
|
||||
interface
|
||||
|
||||
uses classes, FormFactory, MyFormDep;
|
||||
|
||||
Type
|
||||
TMyForm = Class(TComponent)
|
||||
Public
|
||||
Constructor Create(aOWner : TComponent); override;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses web, myformdep2;
|
||||
|
||||
Constructor TMyForm.Create(aOWner : TComponent);
|
||||
|
||||
|
||||
begin
|
||||
window.alert('TMyForm created!');
|
||||
end;
|
||||
|
||||
begin
|
||||
RegisterForm(TMyForm);
|
||||
end.
|
||||
17
demo/dynload/myformdep2.pp
Normal file
17
demo/dynload/myformdep2.pp
Normal file
@ -0,0 +1,17 @@
|
||||
unit myformdep2;
|
||||
|
||||
interface
|
||||
|
||||
Procedure DoLoaded2;
|
||||
|
||||
implementation
|
||||
|
||||
Procedure DoLoaded2;
|
||||
|
||||
begin
|
||||
Writeln('loaded 2');
|
||||
end;
|
||||
|
||||
initialization
|
||||
DoLoaded2;
|
||||
end.
|
||||
15
demo/dynload/testloader.html
Normal file
15
demo/dynload/testloader.html
Normal file
@ -0,0 +1,15 @@
|
||||
<!DOCTYPE html>
|
||||
<html>
|
||||
<head>
|
||||
<title>Script & Unit loader test</title>
|
||||
<meta charset="utf-8"/>
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1.0">
|
||||
<script src="testloader.js" type="application/javascript" ></script>
|
||||
</head>
|
||||
<body>
|
||||
<button id="loader">Load JQuery javascript scripts from google</button>
|
||||
<button id="formloader">Load form</button>
|
||||
<script>rtl.run();</script>
|
||||
</body>
|
||||
</html>
|
||||
|
||||
81
demo/dynload/testloader.lpi
Normal file
81
demo/dynload/testloader.lpi
Normal file
@ -0,0 +1,81 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="11"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
<Runnable Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="testloader"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<CustomData Count="2">
|
||||
<Item0 Name="PasJSPort" Value="0"/>
|
||||
<Item1 Name="PasJSWebBrowserProject" Value="1"/>
|
||||
</CustomData>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="0"/>
|
||||
</RunParams>
|
||||
<Units Count="1">
|
||||
<Unit0>
|
||||
<Filename Value="testloader.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target FileExt=".js">
|
||||
<Filename Value="testloader"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="js"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<AllowLabel Value="False"/>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<TargetOS Value="browser"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<GenerateDebugInfo Value="False"/>
|
||||
<UseLineInfoUnit Value="False"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc -Jminclude"/>
|
||||
<CompilerPath Value="$(pas2js)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
45
demo/dynload/testloader.lpr
Normal file
45
demo/dynload/testloader.lpr
Normal file
@ -0,0 +1,45 @@
|
||||
program testloader;
|
||||
|
||||
uses types, js, web, Rtl.ScriptLoader, Rtl.UnitLoader, FormFactory;
|
||||
|
||||
|
||||
Function DoClick (e : TJSMouseEvent) : boolean;
|
||||
begin
|
||||
LoadScripts([
|
||||
'http://ajax.googleapis.com/ajax/libs/jquery/1.3.2/jquery.min.js',
|
||||
'http://ajax.googleapis.com/ajax/libs/prototype/1.6.1.0/prototype.js'
|
||||
],
|
||||
procedure (data : TObject) begin
|
||||
window. alert('All things are loaded');
|
||||
end, Nil);
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
Function DoFormClick (e : TJSMouseEvent) : boolean;
|
||||
|
||||
procedure DoLoaded(const aUnitName : array of string; aData : TObject);
|
||||
|
||||
Var
|
||||
C : TFormClass;
|
||||
|
||||
begin
|
||||
Writeln('Unit ',aUnitName,' was loaded');
|
||||
C:=GetFormClassByName('TMyForm');
|
||||
if C<>Nil then
|
||||
C.Create(Nil)
|
||||
else
|
||||
begin
|
||||
Writeln('TMyForm not found');
|
||||
window.alert('TMyForm not found');
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
TUnitLoader.Instance.LoadUnit('myform',@DoLoaded);
|
||||
Result:=False;
|
||||
end;
|
||||
|
||||
begin
|
||||
TJSHTMLElement(document.getElementbyID('loader')).onclick:=@DoClick;
|
||||
TJSHTMLElement(document.getElementbyID('formloader')).onclick:=@DoFormClick;
|
||||
end.
|
||||
55
packages/rtl/Rtl.ScriptLoader.pas
Normal file
55
packages/rtl/Rtl.ScriptLoader.pas
Normal file
@ -0,0 +1,55 @@
|
||||
unit Rtl.ScriptLoader;
|
||||
|
||||
interface
|
||||
|
||||
uses types;
|
||||
|
||||
Type
|
||||
TloadedCallBack = Reference to procedure(Data : TObject);
|
||||
TProc = reference to procedure;
|
||||
|
||||
Procedure loadScripts(scripts : TStringDynArray; callback : TLoadedCallback; Data : TObject);
|
||||
|
||||
implementation
|
||||
|
||||
uses js, web;
|
||||
|
||||
Procedure loadScripts(scripts : TStringDynArray; callback : TLoadedCallback; Data : TObject);
|
||||
|
||||
Procedure loader (src : String; handler : TProc);
|
||||
|
||||
var
|
||||
head,script : TJSElement;
|
||||
|
||||
Procedure DoLoaded;
|
||||
|
||||
begin
|
||||
script.Properties['onload']:=Nil;
|
||||
script.Properties['onreadystatechange']:=Nil;
|
||||
Handler;
|
||||
end;
|
||||
|
||||
begin
|
||||
script:= document.createElement('script');
|
||||
script['src'] := src;
|
||||
script.Properties['onload'] := @DoLoaded;
|
||||
script.Properties['onreadystatechange']:=@DoLoaded;
|
||||
head:=TJSElement(document.getElementsByTagName('head')[0]);
|
||||
if Head=Nil then
|
||||
Head:=Document.body;
|
||||
head.appendChild( script );
|
||||
end;
|
||||
|
||||
Procedure run;
|
||||
begin
|
||||
if Length(Scripts)<>0 then
|
||||
loader(String(TJSArray(scripts).shift()), @run)
|
||||
else if Assigned(callback) then
|
||||
callback(data);
|
||||
end;
|
||||
|
||||
begin
|
||||
Run;
|
||||
end;
|
||||
|
||||
end.
|
||||
296
packages/rtl/Rtl.UnitLoader.pas
Normal file
296
packages/rtl/Rtl.UnitLoader.pas
Normal file
@ -0,0 +1,296 @@
|
||||
unit Rtl.UnitLoader;
|
||||
|
||||
interface
|
||||
{ $define DEBUGUNITLOADER}
|
||||
|
||||
uses SysUtils, JS, Types;
|
||||
|
||||
Type
|
||||
EUnitLoader = Class(Exception);
|
||||
|
||||
TLoadedProcedure = Reference to Procedure(const aUnitNames : Array of String; aData : TObject);
|
||||
|
||||
{ TLoadTask }
|
||||
|
||||
TLoadTask = Class(TObject)
|
||||
Private
|
||||
FUnitNames : TStringDynArray; // unit names case sensitive!
|
||||
FInitUnitNames : TStringDynArray; // unit names case sensitive!
|
||||
FOnLoaded : TLoadedProcedure;
|
||||
FData : TObject;
|
||||
function GetAllLoaded : Boolean;
|
||||
Protected
|
||||
Procedure CallLoaded;
|
||||
Public
|
||||
Constructor Create(Const aUnitNames : Array of string; aOnLoaded : TLoadedProcedure; aData : TObject);
|
||||
Procedure UnitLoaded(Const aUnitName : String);
|
||||
Property AllLoaded : Boolean Read GetAllLoaded;
|
||||
Property LoadUnitNames : TStringDynArray Read FUnitNames;
|
||||
Property OnLoaded : TLoadedProcedure Read FOnLoaded;
|
||||
Property Data : TObject Read FData;
|
||||
end;
|
||||
|
||||
{ TUnitLoader }
|
||||
|
||||
TUnitLoader = Class(TObject)
|
||||
Private
|
||||
Class var FInstance : TUnitLoader;
|
||||
procedure DoDependenciesLoaded(const aUnitName: array of string;
|
||||
aData: TObject);
|
||||
Private
|
||||
FBaseURL : String;
|
||||
FLoadList : TStringDynArray; // unitnames case sensitive!
|
||||
function IndexOfLoadUnit(aUnitName : String): integer;
|
||||
protected
|
||||
Procedure AddToLoadList(aUnitName : String);
|
||||
Procedure RemoveFromLoadList(aUnitName : String);
|
||||
function IsInLoadList(aUnitName: String): Boolean;
|
||||
function GetUnitURL(const aUnitName: string): String; virtual;
|
||||
procedure InitModule(aTask: TLoadTask; const aName: String; aModule : JSValue); virtual;
|
||||
procedure DoLoadUnits(const aUnitNames: array of String; aOnLoaded: TLoadedProcedure; aData: TObject); virtual;
|
||||
function AreAllDependenciesLoaded(aTask: TLoadTask; const aName: String; AModule: JSValue): Boolean; virtual;
|
||||
function GetNeededDependencies(const aName: String; AModule: JSValue): TStringDynArray;
|
||||
procedure UnitSourcesLoaded(aData : TObject); virtual;
|
||||
Public
|
||||
Class Function Instance : TUnitLoader;
|
||||
function FindModule(aModuleName: string): JSValue;
|
||||
function HaveModule(aModuleName: string): Boolean;
|
||||
procedure LoadUnit(Const aUnitName : string; aOnLoaded : TLoadedProcedure = Nil; aData : TObject = Nil);
|
||||
procedure LoadUnits(Const aUnitNames : Array of String; aOnLoaded : TLoadedProcedure = Nil; aData : TObject = Nil);
|
||||
Property BaseURL : String Read FBaseUrl Write FBaseURL;
|
||||
end;
|
||||
|
||||
|
||||
Implementation
|
||||
|
||||
uses Rtl.ScriptLoader;
|
||||
|
||||
function IndexOfI(arr: TStringDynArray; Name: string): integer;
|
||||
begin
|
||||
Result:=length(arr)-1;
|
||||
while (Result>=0) and not SameText(arr[Result],Name) do
|
||||
dec(Result);
|
||||
end;
|
||||
|
||||
function TLoadTask.GetAllLoaded: Boolean;
|
||||
begin
|
||||
Result:=Length(FInitunitNames)=0;
|
||||
end;
|
||||
|
||||
procedure TLoadTask.CallLoaded;
|
||||
begin
|
||||
if Assigned(OnLoaded) then
|
||||
OnLoaded(LoadUnitNames,Data);
|
||||
end;
|
||||
|
||||
constructor TLoadTask.Create(const aUnitNames: array of string;
|
||||
aOnLoaded: TLoadedProcedure; aData: TObject);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
SetLength(FunitNames,Length(aUnitNames));
|
||||
SetLength(FInitUnitNames,Length(aUnitNames));
|
||||
for I:=Low(aUnitNames) to High(aUnitNames) do
|
||||
begin
|
||||
FUnitNames[i]:=aUnitNames[i];
|
||||
FInitUnitNames[i]:=aUnitNames[i];
|
||||
end;
|
||||
FOnLoaded:=aOnLoaded;
|
||||
FData:=aData;
|
||||
end;
|
||||
|
||||
procedure TLoadTask.UnitLoaded(const aUnitName: String);
|
||||
|
||||
var
|
||||
Idx : integer;
|
||||
|
||||
begin
|
||||
{$IFDEF DEBUGUNITLOADER}Writeln('Unit ',aUnitName,' loaded, removing from list');{$ENDIF}
|
||||
Idx:=IndexOfI(FInitUnitNames,aUnitName);
|
||||
if Idx>-1 then
|
||||
TJSArray(FInitUnitNames).splice(Idx,1);
|
||||
end;
|
||||
|
||||
class function TUnitLoader.Instance: TUnitLoader;
|
||||
|
||||
begin
|
||||
if (FInstance=Nil) then
|
||||
FInstance:=TUnitLoader.Create;
|
||||
Result:=FInstance;
|
||||
end;
|
||||
|
||||
Procedure LoadIntf(aModule : JSValue); external name 'rtl.loadintf';
|
||||
Procedure LoadImpl(aModule : JSValue); external name 'rtl.loadimpl';
|
||||
var pas : TJSOBject; external name 'pas';
|
||||
|
||||
function TUnitLoader.FindModule(aModuleName: string): JSValue;
|
||||
var
|
||||
Key: string;
|
||||
begin
|
||||
Result:=pas[aModuleName];
|
||||
if isModule(Result) then exit;
|
||||
for Key in pas do
|
||||
begin
|
||||
if not SameText(Key,aModuleName) then continue;
|
||||
Result:=pas[Key];
|
||||
if isModule(Result) then exit;
|
||||
end;
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TUnitLoader.HaveModule(aModuleName: string): Boolean;
|
||||
begin
|
||||
Result:=FindModule(aModuleName)<>nil;
|
||||
end;
|
||||
|
||||
procedure TUnitLoader.InitModule(aTask: TLoadTask; const aName: String;
|
||||
aModule: JSValue);
|
||||
|
||||
begin
|
||||
{$IFDEF DEBUGUNITLOADER} Writeln('Unit ',aName,' dependencies loaded. Initialising "',TJSObject(aModule)['$name'],'" ...');{$ENDIF}
|
||||
RemoveFromLoadList(aName);
|
||||
LoadIntf(aModule);
|
||||
LoadImpl(aModule);
|
||||
aTask.UnitLoaded(aName);
|
||||
end;
|
||||
|
||||
function TUnitLoader.GetNeededDependencies(const aName: String; AModule: JSValue
|
||||
): TStringDynArray;
|
||||
|
||||
var
|
||||
l,u : TStringDynArray;
|
||||
m : String;
|
||||
begin
|
||||
SetLength(l,0);
|
||||
u:=TStringDynArray(TJSOBject(aModule)['$intfuseslist']);
|
||||
for m in u do
|
||||
if not (HaveModule(m) or IsInLoadList(m)) then
|
||||
TJSArray(l).push(m);
|
||||
u:=TStringDynArray(TJSOBject(aModule)['$impluseslist']);
|
||||
for m in u do
|
||||
if not (HaveModule(m) or IsInLoadList(m)) then
|
||||
TJSArray(l).push(m);
|
||||
Result:=l;
|
||||
end;
|
||||
|
||||
function TUnitLoader.AreAllDependenciesLoaded(aTask: TLoadTask;
|
||||
const aName: String; AModule: JSValue): Boolean;
|
||||
|
||||
begin
|
||||
Result:=Length(GetNeededDependencies(aName,aModule))=0;
|
||||
end;
|
||||
|
||||
procedure TUnitLoader.DoDependenciesLoaded(const aUnitName : array of string; aData : TObject);
|
||||
|
||||
begin
|
||||
UnitSourcesLoaded(aData);
|
||||
end;
|
||||
|
||||
function TUnitLoader.IndexOfLoadUnit(aUnitName: String): integer;
|
||||
begin
|
||||
Result:=IndexOfI(FLoadList,aUnitName);
|
||||
end;
|
||||
|
||||
procedure TUnitLoader.AddToLoadList(aUnitName: String);
|
||||
begin
|
||||
if IndexOfLoadUnit(aUnitName)<0 then
|
||||
TJSArray(FLoadList).Push(aUnitName);
|
||||
end;
|
||||
|
||||
procedure TUnitLoader.RemoveFromLoadList(aUnitName: String);
|
||||
var
|
||||
idx : Integer;
|
||||
begin
|
||||
Idx:=IndexOfLoadUnit(aUnitName);
|
||||
if Idx>-1 then
|
||||
TJSArray(FLoadList).splice(Idx,1);
|
||||
end;
|
||||
|
||||
function TUnitLoader.IsInLoadList(aUnitName: String): Boolean;
|
||||
begin
|
||||
Result:=IndexOfLoadUnit(aUnitName)>=0;
|
||||
end;
|
||||
|
||||
procedure TUnitLoader.UnitSourcesLoaded(aData : TObject);
|
||||
|
||||
Var
|
||||
aTask : TLoadTask;
|
||||
aModule : JSValue;
|
||||
aModuleName : String;
|
||||
Deps : TStringDynArray;
|
||||
|
||||
begin
|
||||
{$IFDEF DEBUGUNITLOADER} Writeln('Succesfully loaded sources');{$ENDIF}
|
||||
aTask:=TLoadTask(aData);
|
||||
For aModuleName in aTask.LoadUnitNames do
|
||||
begin
|
||||
aModule:=FindModule(aModuleName);
|
||||
if aModule<>nil then
|
||||
begin
|
||||
{$IFDEF DEBUGUNITLOADER} Writeln(aModuleName+' is module. Loading interface');{$ENDIF}
|
||||
Deps:=GetNeededDependencies(aModuleName,aModule);
|
||||
if length(Deps)=0 then
|
||||
InitModule(aTask,aModuleName,aModule)
|
||||
else
|
||||
DoLoadUnits(Deps,@DoDependenciesLoaded,aData);
|
||||
end;
|
||||
end;
|
||||
if (aTask.AllLoaded) then
|
||||
aTask.CallLoaded;
|
||||
end;
|
||||
|
||||
function TUnitLoader.GetUnitURL(const aUnitName: string): String;
|
||||
|
||||
begin
|
||||
Result:=BaseURL;
|
||||
if (Result<>'') then
|
||||
Result:=Result+'/';
|
||||
Result:=Result+aUnitname+'.js';
|
||||
end;
|
||||
|
||||
procedure TUnitLoader.LoadUnit(const aUnitName : string; aOnLoaded : TLoadedProcedure = Nil; aData : TObject = Nil);
|
||||
|
||||
begin
|
||||
LoadUnits([aUnitName],aOnLoaded,aData);
|
||||
end;
|
||||
|
||||
procedure TUnitLoader.LoadUnits(const aUnitNames: array of String; aOnLoaded: TLoadedProcedure; aData: TObject);
|
||||
|
||||
begin
|
||||
if Length(FLoadList)>0 then
|
||||
Raise EUnitLoader.Create('Load operation in progress. Cannot load.');
|
||||
DoLoadUnits(aUnitNames,aOnLoaded,aData);
|
||||
end;
|
||||
|
||||
procedure TUnitLoader.DoLoadUnits(const aUnitNames: array of String; aOnLoaded: TLoadedProcedure; aData: TObject);
|
||||
|
||||
Var
|
||||
Scripts : TStringDynArray;
|
||||
aCount : Integer;
|
||||
S : String;
|
||||
|
||||
begin
|
||||
aCount:=0;
|
||||
Setlength(Scripts,Length(aUnitNames));
|
||||
for s in aUnitNames do
|
||||
if Not HaveModule(S) then
|
||||
begin
|
||||
{$IFDEF DEBUGUNITLOADER} Writeln('Need to load unit: ',S);{$ENDIF}
|
||||
Scripts[aCount]:=GetUnitURl(S);
|
||||
AddToLoadList(S);
|
||||
inc(aCount);
|
||||
end;
|
||||
SetLength(S,aCount);
|
||||
if aCount=0 then
|
||||
begin
|
||||
// All is already loaded
|
||||
if Assigned(aOnLoaded) then
|
||||
aOnLoaded(aUnitNames,aData);
|
||||
end
|
||||
else
|
||||
LoadScripts(Scripts,@UnitSourcesLoaded,TLoadTask.Create(aUnitNames,aOnLoaded,aData));
|
||||
end;
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user