mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-24 18:22:25 -05:00
First working concept.
This commit is contained in:
parent
ec2e00a057
commit
0f25bc7d06
16
Extensions/test.pas
Normal file
16
Extensions/test.pas
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
program new;
|
||||||
|
|
||||||
|
{ Creating TForm crashed for me, but probably because I'm on Linux x86_64 }
|
||||||
|
procedure init;
|
||||||
|
|
||||||
|
//var
|
||||||
|
// a: TForm;
|
||||||
|
begin
|
||||||
|
createf;
|
||||||
|
// a := TForm.Create(nil);
|
||||||
|
// a.ShowModal;
|
||||||
|
// a.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
end.
|
@ -6,7 +6,7 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, virtualextension,
|
Classes, SysUtils, virtualextension,
|
||||||
uPSComponent,uPSCompiler, uPSRuntime, uPSPreProcessor;
|
uPSComponent,uPSCompiler, uPSRuntime, uPSPreProcessor,forms;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -18,6 +18,7 @@ type
|
|||||||
private
|
private
|
||||||
PSInstance: TPSScript;
|
PSInstance: TPSScript;
|
||||||
FEnabled: Boolean;
|
FEnabled: Boolean;
|
||||||
|
Script: TStringList;
|
||||||
|
|
||||||
private
|
private
|
||||||
function InitScript: Boolean;
|
function InitScript: Boolean;
|
||||||
@ -29,6 +30,7 @@ type
|
|||||||
protected
|
protected
|
||||||
procedure RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
|
procedure RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
|
||||||
procedure RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
|
procedure RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
|
||||||
|
procedure RegisterMyMethods(Sender: TPSScript);
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -40,63 +42,53 @@ uses
|
|||||||
uPSR_extctrls //Runtime-libs;
|
uPSR_extctrls //Runtime-libs;
|
||||||
;
|
;
|
||||||
|
|
||||||
procedure TSimbaPSEventExtension.OutputMessages;
|
procedure createf;
|
||||||
var
|
var
|
||||||
l: Longint;
|
a: TForm;
|
||||||
b: Boolean;
|
|
||||||
begin
|
begin
|
||||||
b := False;
|
a:=TForm.Create(nil);
|
||||||
for l := 0 to PSInstance.CompilerMessageCount - 1 do
|
a.ShowModal;
|
||||||
begin
|
a.Free;
|
||||||
if (not b) and (PSInstance.CompilerMessages[l] is TIFPSPascalCompilerError) then
|
end;
|
||||||
begin
|
|
||||||
b := True;
|
|
||||||
{if OnError <> nil then
|
|
||||||
with PSInstance.CompilerMessages[l] do
|
|
||||||
HandleError(Row, Col, Pos, MessageToString,errCompile, ModuleName)
|
|
||||||
else }
|
|
||||||
writeln(PSInstance.CompilerErrorToStr(l) + ' at line ' + inttostr(PSInstance.CompilerMessages[l].Row));
|
|
||||||
end else
|
|
||||||
Writeln(PSInstance.CompilerErrorToStr(l) + ' at line ' + inttostr(PSInstance.CompilerMessages[l].Row));
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
function TSimbaPSEventExtension.HookExists(HookName: String): Boolean;
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TSimbaPSEventExtension.ExecuteHook(HookName: String): Integer;
|
||||||
|
begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
constructor TSimbaPSEventExtension.Create(FileName: String);
|
constructor TSimbaPSEventExtension.Create(FileName: String);
|
||||||
var
|
var
|
||||||
fStr:TFileStream;
|
fStr:TFileStream;
|
||||||
Script: String;
|
|
||||||
strs: TStrings;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
// FIXME
|
inherited create;
|
||||||
//inherited;
|
|
||||||
try
|
try
|
||||||
|
Script := TStringList.Create;
|
||||||
fStr := TFileStream.Create(FileName, fmOpenRead);
|
fStr := TFileStream.Create(FileName, fmOpenRead);
|
||||||
SetLength(Script, fStr.Size);
|
Script.LoadFromStream(fStr);
|
||||||
fStr.Read(Script[1],fStr.Size);
|
fStr.Free;
|
||||||
except
|
except
|
||||||
raise Exception.CreateFmt('File %s could not be read', [FileName]);
|
raise Exception.CreateFmt('File %s could not be read', [FileName]);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
try
|
|
||||||
fStr.Free;
|
|
||||||
finally
|
|
||||||
end;
|
|
||||||
|
|
||||||
Strs := TStringList.Create;
|
|
||||||
Strs.Add(Script);
|
|
||||||
|
|
||||||
FEnabled := False;
|
FEnabled := False;
|
||||||
|
|
||||||
|
{ Create script, and see if the extension is valid. (If it compiles) }
|
||||||
|
|
||||||
PSInstance := TPSScript.Create(nil);
|
PSInstance := TPSScript.Create(nil);
|
||||||
|
|
||||||
PSInstance.Script := Strs;
|
PSInstance.Script := Self.Script;
|
||||||
PSInstance.OnCompImport:=@RegisterPSCComponents;
|
PSInstance.OnCompImport:=@RegisterPSCComponents;
|
||||||
PSInstance.OnExecImport:=@RegisterPSRComponents;
|
PSInstance.OnExecImport:=@RegisterPSRComponents;
|
||||||
|
PSInstance.OnCompile:=@RegisterMyMethods;
|
||||||
|
|
||||||
Writeln(Format('%s: Script: %s', [FileName, Script]));
|
Writeln(Format('%s: Script: %s', [FileName, Self.Script.Text]));
|
||||||
|
|
||||||
try
|
try
|
||||||
FEnabled := PSInstance.Compile;
|
FEnabled := PSInstance.Compile;
|
||||||
@ -114,10 +106,8 @@ begin
|
|||||||
if FEnabled then
|
if FEnabled then
|
||||||
writeln('It exists')
|
writeln('It exists')
|
||||||
else
|
else
|
||||||
writeln('It does not exist');
|
writeln('It does not exist - or something went wrong while executing it.');
|
||||||
// writeln(PSInstance.ExecuteFunction([], 'test'));
|
// writeln(PSInstance.ExecuteFunction([], 'test'));
|
||||||
|
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TSimbaPSEventExtension.InitScript: Boolean;
|
function TSimbaPSEventExtension.InitScript: Boolean;
|
||||||
@ -134,6 +124,12 @@ begin
|
|||||||
exit(true);
|
exit(true);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TSimbaPSEventExtension.RegisterMyMethods(Sender: TPSScript);
|
||||||
|
begin
|
||||||
|
Sender.AddFunction(@createf, 'procedure createf;');
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TSimbaPSEventExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
|
procedure TSimbaPSEventExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
|
||||||
begin
|
begin
|
||||||
SIRegister_Std(x);
|
SIRegister_Std(x);
|
||||||
@ -167,14 +163,32 @@ begin
|
|||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TSimbaPSEventExtension.HookExists(HookName: String): Boolean;
|
|
||||||
begin
|
|
||||||
|
|
||||||
|
procedure TSimbaPSEventExtension.OutputMessages;
|
||||||
|
var
|
||||||
|
l: Longint;
|
||||||
|
b: Boolean;
|
||||||
|
begin
|
||||||
|
b := False;
|
||||||
|
for l := 0 to PSInstance.CompilerMessageCount - 1 do
|
||||||
|
begin
|
||||||
|
if (not b) and (PSInstance.CompilerMessages[l] is TIFPSPascalCompilerError) then
|
||||||
|
begin
|
||||||
|
b := True;
|
||||||
|
with PSInstance.CompilerMessages[l] do
|
||||||
|
writeln(MessageToString);
|
||||||
|
{if OnError <> nil then
|
||||||
|
with PSInstance.CompilerMessages[l] do
|
||||||
|
HandleError(Row, Col, Pos, MessageToString,errCompile, ModuleName)
|
||||||
|
else }
|
||||||
|
writeln(PSInstance.CompilerErrorToStr(l) + ' at line ' + inttostr(PSInstance.CompilerMessages[l].Row));
|
||||||
|
end else
|
||||||
|
Writeln(PSInstance.CompilerErrorToStr(l) + ' at line ' + inttostr(PSInstance.CompilerMessages[l].Row));
|
||||||
|
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TSimbaPSEventExtension.ExecuteHook(HookName: String): Integer;
|
|
||||||
begin
|
|
||||||
end;
|
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
@ -41,7 +41,8 @@ uses
|
|||||||
SynExportHTML, SynEditKeyCmds, SynEditHighlighter,
|
SynExportHTML, SynEditKeyCmds, SynEditHighlighter,
|
||||||
SynEditMarkupHighAll, LMessages, Buttons,
|
SynEditMarkupHighAll, LMessages, Buttons,
|
||||||
stringutil,mufasatypesutil,mufasabase,
|
stringutil,mufasatypesutil,mufasabase,
|
||||||
about, framefunctionlist, ocr, updateform, simbasettings;
|
about, framefunctionlist, ocr, updateform, simbasettings,
|
||||||
|
eventextension;
|
||||||
|
|
||||||
const
|
const
|
||||||
SimbaVersion = 585;
|
SimbaVersion = 585;
|
||||||
@ -2006,8 +2007,18 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TForm1.ButtonTrayClick(Sender: TObject);
|
procedure TForm1.ButtonTrayClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
Ext: TSimbaPSEventExtension;
|
||||||
|
{ FIXME: Turning it into a test button again... }
|
||||||
begin
|
begin
|
||||||
Form1.Hide;
|
{Form1.Hide; }
|
||||||
|
try
|
||||||
|
Ext := TSimbaPSEventExtension.Create(MainDir + DS + 'Extensions' + DS + 'test.pas');
|
||||||
|
Ext.Free;
|
||||||
|
except
|
||||||
|
Writeln('Something went wrong with the Extensions.');
|
||||||
|
end;
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean
|
procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean
|
||||||
|
@ -10,7 +10,6 @@ uses
|
|||||||
type
|
type
|
||||||
TVirtualSimbaExtension = class(TObject)
|
TVirtualSimbaExtension = class(TObject)
|
||||||
public
|
public
|
||||||
|
|
||||||
{ Must be implemented }
|
{ Must be implemented }
|
||||||
function HookExists(HookName: String): Boolean; virtual; abstract;
|
function HookExists(HookName: String): Boolean; virtual; abstract;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user