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
|
||||
Classes, SysUtils, virtualextension,
|
||||
uPSComponent,uPSCompiler, uPSRuntime, uPSPreProcessor;
|
||||
uPSComponent,uPSCompiler, uPSRuntime, uPSPreProcessor,forms;
|
||||
|
||||
|
||||
|
||||
@ -18,6 +18,7 @@ type
|
||||
private
|
||||
PSInstance: TPSScript;
|
||||
FEnabled: Boolean;
|
||||
Script: TStringList;
|
||||
|
||||
private
|
||||
function InitScript: Boolean;
|
||||
@ -29,6 +30,7 @@ type
|
||||
protected
|
||||
procedure RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
|
||||
procedure RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
|
||||
procedure RegisterMyMethods(Sender: TPSScript);
|
||||
|
||||
end;
|
||||
|
||||
@ -40,63 +42,53 @@ uses
|
||||
uPSR_extctrls //Runtime-libs;
|
||||
;
|
||||
|
||||
procedure TSimbaPSEventExtension.OutputMessages;
|
||||
procedure createf;
|
||||
var
|
||||
l: Longint;
|
||||
b: Boolean;
|
||||
a: TForm;
|
||||
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;
|
||||
{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));
|
||||
a:=TForm.Create(nil);
|
||||
a.ShowModal;
|
||||
a.Free;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function TSimbaPSEventExtension.HookExists(HookName: String): Boolean;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
function TSimbaPSEventExtension.ExecuteHook(HookName: String): Integer;
|
||||
begin
|
||||
end;
|
||||
|
||||
constructor TSimbaPSEventExtension.Create(FileName: String);
|
||||
var
|
||||
fStr:TFileStream;
|
||||
Script: String;
|
||||
strs: TStrings;
|
||||
|
||||
begin
|
||||
// FIXME
|
||||
//inherited;
|
||||
inherited create;
|
||||
|
||||
try
|
||||
Script := TStringList.Create;
|
||||
fStr := TFileStream.Create(FileName, fmOpenRead);
|
||||
SetLength(Script, fStr.Size);
|
||||
fStr.Read(Script[1],fStr.Size);
|
||||
Script.LoadFromStream(fStr);
|
||||
fStr.Free;
|
||||
except
|
||||
raise Exception.CreateFmt('File %s could not be read', [FileName]);
|
||||
end;
|
||||
|
||||
try
|
||||
fStr.Free;
|
||||
finally
|
||||
end;
|
||||
|
||||
Strs := TStringList.Create;
|
||||
Strs.Add(Script);
|
||||
|
||||
FEnabled := False;
|
||||
|
||||
{ Create script, and see if the extension is valid. (If it compiles) }
|
||||
|
||||
PSInstance := TPSScript.Create(nil);
|
||||
|
||||
PSInstance.Script := Strs;
|
||||
PSInstance.Script := Self.Script;
|
||||
PSInstance.OnCompImport:=@RegisterPSCComponents;
|
||||
PSInstance.OnExecImport:=@RegisterPSRComponents;
|
||||
PSInstance.OnCompile:=@RegisterMyMethods;
|
||||
|
||||
Writeln(Format('%s: Script: %s', [FileName, Script]));
|
||||
Writeln(Format('%s: Script: %s', [FileName, Self.Script.Text]));
|
||||
|
||||
try
|
||||
FEnabled := PSInstance.Compile;
|
||||
@ -114,10 +106,8 @@ begin
|
||||
if FEnabled then
|
||||
writeln('It exists')
|
||||
else
|
||||
writeln('It does not exist');
|
||||
// writeln(PSInstance.ExecuteFunction([], 'test'));
|
||||
|
||||
|
||||
writeln('It does not exist - or something went wrong while executing it.');
|
||||
// writeln(PSInstance.ExecuteFunction([], 'test'));
|
||||
end;
|
||||
|
||||
function TSimbaPSEventExtension.InitScript: Boolean;
|
||||
@ -134,6 +124,12 @@ begin
|
||||
exit(true);
|
||||
end;
|
||||
|
||||
|
||||
procedure TSimbaPSEventExtension.RegisterMyMethods(Sender: TPSScript);
|
||||
begin
|
||||
Sender.AddFunction(@createf, 'procedure createf;');
|
||||
end;
|
||||
|
||||
procedure TSimbaPSEventExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
|
||||
begin
|
||||
SIRegister_Std(x);
|
||||
@ -167,14 +163,32 @@ begin
|
||||
inherited;
|
||||
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;
|
||||
|
||||
function TSimbaPSEventExtension.ExecuteHook(HookName: String): Integer;
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
@ -41,7 +41,8 @@ uses
|
||||
SynExportHTML, SynEditKeyCmds, SynEditHighlighter,
|
||||
SynEditMarkupHighAll, LMessages, Buttons,
|
||||
stringutil,mufasatypesutil,mufasabase,
|
||||
about, framefunctionlist, ocr, updateform, simbasettings;
|
||||
about, framefunctionlist, ocr, updateform, simbasettings,
|
||||
eventextension;
|
||||
|
||||
const
|
||||
SimbaVersion = 585;
|
||||
@ -2006,8 +2007,18 @@ begin
|
||||
end;
|
||||
|
||||
procedure TForm1.ButtonTrayClick(Sender: TObject);
|
||||
var
|
||||
Ext: TSimbaPSEventExtension;
|
||||
{ FIXME: Turning it into a test button again... }
|
||||
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;
|
||||
|
||||
procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean
|
||||
|
@ -10,7 +10,6 @@ uses
|
||||
type
|
||||
TVirtualSimbaExtension = class(TObject)
|
||||
public
|
||||
|
||||
{ Must be implemented }
|
||||
function HookExists(HookName: String): Boolean; virtual; abstract;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user