1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-23 15:58:51 -05:00

Incomplete Extensions, but definitely a PoC

This commit is contained in:
Merlijn Wajer 2010-03-15 23:42:39 +01:00
parent 33702f35a4
commit ec2e00a057
3 changed files with 233 additions and 0 deletions

View File

@ -0,0 +1,180 @@
unit eventextension;
{$mode objfpc}
interface
uses
Classes, SysUtils, virtualextension,
uPSComponent,uPSCompiler, uPSRuntime, uPSPreProcessor;
type
TSimbaPSEventExtension = class(TVirtualSimbaExtension)
public
constructor Create(FileName: String);
destructor Destroy; override;
private
PSInstance: TPSScript;
FEnabled: Boolean;
private
function InitScript: Boolean;
procedure OutputMessages;
public
function HookExists(HookName: String): Boolean; override;
function ExecuteHook(HookName: String): Integer; override;
protected
procedure RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
procedure RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
end;
implementation
uses
uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms,
uPSC_extctrls, //Compile libs
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,
uPSR_extctrls //Runtime-libs;
;
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;
{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;
constructor TSimbaPSEventExtension.Create(FileName: String);
var
fStr:TFileStream;
Script: String;
strs: TStrings;
begin
// FIXME
//inherited;
try
fStr := TFileStream.Create(FileName, fmOpenRead);
SetLength(Script, fStr.Size);
fStr.Read(Script[1],fStr.Size);
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;
PSInstance := TPSScript.Create(nil);
PSInstance.Script := Strs;
PSInstance.OnCompImport:=@RegisterPSCComponents;
PSInstance.OnExecImport:=@RegisterPSRComponents;
Writeln(Format('%s: Script: %s', [FileName, Script]));
try
FEnabled := PSInstance.Compile;
finally
if FEnabled then
writeln('Extension Enabled')
else
begin
writeln('Extension Disabled - Did not compile');
OutputMessages;
end;
end;
FEnabled := InitScript();
if FEnabled then
writeln('It exists')
else
writeln('It does not exist');
// writeln(PSInstance.ExecuteFunction([], 'test'));
end;
function TSimbaPSEventExtension.InitScript: Boolean;
begin
if PSInstance.GetProcMethod('init').Data = nil then
exit(false);
try
PSInstance.ExecuteFunction([], 'init');
except
result := false;
exit;
end;
exit(true);
end;
procedure TSimbaPSEventExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
begin
SIRegister_Std(x);
SIRegister_Classes(x, True);
SIRegister_Controls(x);
SIRegister_Graphics(x, True);
SIRegister_stdctrls(x);
SIRegister_Forms(x);
SIRegister_ExtCtrls(x);
end;
procedure TSimbaPSEventExtension.RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
begin
RIRegister_Std(x);
RIRegister_Classes(x, True);
RIRegister_Controls(x);
RIRegister_Graphics(x, True);
RIRegister_stdctrls(x);
RIRegister_Forms(x);
RIRegister_ExtCtrls(x);
end;
destructor TSimbaPSEventExtension.Destroy;
begin
if Assigned(PSInstance) then
FreeAndNil(PSInstance);
WriteLn('Closing extension');
inherited;
end;
function TSimbaPSEventExtension.HookExists(HookName: String): Boolean;
begin
end;
function TSimbaPSEventExtension.ExecuteHook(HookName: String): Integer;
begin
end;
end.

View File

@ -0,0 +1,24 @@
unit extensionmanager;
{$mode objfpc}
interface
uses
Classes, SysUtils;
type
(**
TExtensionManager holds a list of VirtualExtensions, and
has functions to easily handle hooks.
*)
TExtensionManager = class(TObject)
end;
implementation
end.

View File

@ -0,0 +1,29 @@
unit virtualextension;
{$mode objfpc}
interface
uses
Classes, SysUtils;
type
TVirtualSimbaExtension = class(TObject)
public
{ Must be implemented }
function HookExists(HookName: String): Boolean; virtual; abstract;
{ No Custom Arguments just yet... }
function ExecuteHook(HookName: String): Integer; virtual; abstract;
private
FName: String;
property GetName: String read Fname;
end;
implementation
end.