1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-24 18:22:25 -05:00

First working concept.

This commit is contained in:
Merlijn Wajer 2010-03-16 00:31:03 +01:00
parent ec2e00a057
commit 0f25bc7d06
4 changed files with 86 additions and 46 deletions

16
Extensions/test.pas Normal file
View 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.

View File

@ -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;
a.Free;
end;
function TSimbaPSEventExtension.HookExists(HookName: String): Boolean;
begin 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));
end; 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;
procedure TSimbaPSEventExtension.OutputMessages;
var
l: Longint;
b: Boolean;
begin 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;
end. end.

View File

@ -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

View File

@ -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;