mirror of
https://github.com/moparisthebest/Simba
synced 2025-01-30 23:00:18 -05:00
Watch the case sensitivity please. ;)
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@40 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup?
parent
9a55b3711f
commit
2abd1feb48
@ -7,7 +7,7 @@
|
||||
<TargetFileExt Value=""/>
|
||||
<Title Value="Mufasa Stand Alone"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<ActiveEditorIndexAtStart Value="8"/>
|
||||
<ActiveEditorIndexAtStart Value="7"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<ProjectVersion Value=""/>
|
||||
@ -33,13 +33,13 @@
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="64">
|
||||
<Units Count="66">
|
||||
<Unit0>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="project1"/>
|
||||
<CursorPos X="13" Y="17"/>
|
||||
<TopLine Value="7"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<UsageCount Value="70"/>
|
||||
<Loaded Value="True"/>
|
||||
@ -171,8 +171,8 @@
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="TestUnit"/>
|
||||
<CursorPos X="19" Y="271"/>
|
||||
<TopLine Value="259"/>
|
||||
<EditorIndex Value="7"/>
|
||||
<TopLine Value="255"/>
|
||||
<EditorIndex Value="6"/>
|
||||
<UsageCount Value="36"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit18>
|
||||
@ -304,7 +304,7 @@
|
||||
<UnitName Value="Client"/>
|
||||
<CursorPos X="25" Y="4"/>
|
||||
<TopLine Value="4"/>
|
||||
<EditorIndex Value="5"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<UsageCount Value="35"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit37>
|
||||
@ -313,8 +313,8 @@
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="MufasaTypes"/>
|
||||
<CursorPos X="4" Y="26"/>
|
||||
<TopLine Value="12"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<UsageCount Value="35"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit38>
|
||||
@ -339,7 +339,7 @@
|
||||
<UnitName Value="Window"/>
|
||||
<CursorPos X="8" Y="262"/>
|
||||
<TopLine Value="255"/>
|
||||
<EditorIndex Value="6"/>
|
||||
<EditorIndex Value="5"/>
|
||||
<UsageCount Value="35"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit41>
|
||||
@ -377,7 +377,7 @@
|
||||
<UnitName Value="finder"/>
|
||||
<CursorPos X="24" Y="130"/>
|
||||
<TopLine Value="111"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<UsageCount Value="28"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit46>
|
||||
@ -406,9 +406,9 @@
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="mmlpsthread"/>
|
||||
<CursorPos X="23" Y="160"/>
|
||||
<TopLine Value="150"/>
|
||||
<EditorIndex Value="8"/>
|
||||
<CursorPos X="11" Y="46"/>
|
||||
<TopLine Value="31"/>
|
||||
<EditorIndex Value="7"/>
|
||||
<UsageCount Value="24"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit50>
|
||||
@ -417,7 +417,7 @@
|
||||
<UnitName Value="uPSComponent"/>
|
||||
<CursorPos X="21" Y="193"/>
|
||||
<TopLine Value="183"/>
|
||||
<EditorIndex Value="13"/>
|
||||
<EditorIndex Value="9"/>
|
||||
<UsageCount Value="13"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit51>
|
||||
@ -425,34 +425,28 @@
|
||||
<Filename Value="../../../FPC/FPCCheckout/rtl/objpas/classes/classesh.inc"/>
|
||||
<CursorPos X="94" Y="494"/>
|
||||
<TopLine Value="489"/>
|
||||
<EditorIndex Value="12"/>
|
||||
<UsageCount Value="13"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit52>
|
||||
<Unit53>
|
||||
<Filename Value="../../../FPC/FPCCheckout/rtl/objpas/types.pp"/>
|
||||
<UnitName Value="types"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="11"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit53>
|
||||
<Unit54>
|
||||
<Filename Value="../../../FPC/FPCCheckout/rtl/objpas/typinfo.pp"/>
|
||||
<UnitName Value="typinfo"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="10"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit54>
|
||||
<Unit55>
|
||||
<Filename Value="../../Units/PascalScript/uPSC_forms.pas"/>
|
||||
<UnitName Value="uPSC_forms"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="9"/>
|
||||
<EditorIndex Value="8"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit55>
|
||||
@ -469,9 +463,7 @@
|
||||
<UnitName Value="LResources"/>
|
||||
<CursorPos X="3" Y="1396"/>
|
||||
<TopLine Value="1396"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit57>
|
||||
<Unit58>
|
||||
<Filename Value="../../../lazarus/components/synedit/synmemo.pas"/>
|
||||
@ -515,8 +507,22 @@
|
||||
<TopLine Value="124"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit63>
|
||||
<Unit64>
|
||||
<Filename Value="../../Units/PascalScript/uPSC_std.pas"/>
|
||||
<UnitName Value="uPSC_std"/>
|
||||
<CursorPos X="35" Y="8"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit64>
|
||||
<Unit65>
|
||||
<Filename Value="../../Units/PascalScript/uPSC_controls.pas"/>
|
||||
<UnitName Value="uPSC_controls"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="11"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit65>
|
||||
</Units>
|
||||
<JumpHistory Count="16" HistoryIndex="15">
|
||||
<JumpHistory Count="18" HistoryIndex="17">
|
||||
<Position1>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="274" Column="26" TopLine="258"/>
|
||||
@ -543,44 +549,52 @@
|
||||
</Position6>
|
||||
<Position7>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="8" Column="73" TopLine="22"/>
|
||||
<Caret Line="30" Column="45" TopLine="22"/>
|
||||
</Position7>
|
||||
<Position8>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="30" Column="45" TopLine="22"/>
|
||||
<Caret Line="225" Column="50" TopLine="217"/>
|
||||
</Position8>
|
||||
<Position9>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="225" Column="50" TopLine="217"/>
|
||||
<Caret Line="227" Column="5" TopLine="219"/>
|
||||
</Position9>
|
||||
<Position10>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="227" Column="5" TopLine="219"/>
|
||||
<Caret Line="53" Column="19" TopLine="40"/>
|
||||
</Position10>
|
||||
<Position11>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="53" Column="19" TopLine="40"/>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="279" Column="3" TopLine="270"/>
|
||||
</Position11>
|
||||
<Position12>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="279" Column="3" TopLine="270"/>
|
||||
<Caret Line="271" Column="19" TopLine="259"/>
|
||||
</Position12>
|
||||
<Position13>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="271" Column="19" TopLine="259"/>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="65" Column="26" TopLine="22"/>
|
||||
</Position13>
|
||||
<Position14>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="65" Column="26" TopLine="22"/>
|
||||
<Caret Line="49" Column="15" TopLine="21"/>
|
||||
</Position14>
|
||||
<Position15>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="49" Column="15" TopLine="21"/>
|
||||
<Caret Line="55" Column="16" TopLine="26"/>
|
||||
</Position15>
|
||||
<Position16>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="55" Column="16" TopLine="26"/>
|
||||
<Caret Line="7" Column="22" TopLine="1"/>
|
||||
</Position16>
|
||||
<Position17>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="45" Column="74" TopLine="29"/>
|
||||
</Position17>
|
||||
<Position18>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="198" Column="19" TopLine="183"/>
|
||||
</Position18>
|
||||
</JumpHistory>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
||||
@ -1,245 +1,246 @@
|
||||
unit mmlpsthread;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,SynMemo;
|
||||
|
||||
type
|
||||
|
||||
{ TMMLPSThread }
|
||||
|
||||
TMMLPSThread = class(TThread)
|
||||
protected
|
||||
// PSScript : TPSScript;
|
||||
// PSClient : TPSScript;
|
||||
// Client: TClient;
|
||||
// DebugTo : TStrings;
|
||||
Client : TClient;
|
||||
PSScript : TPSScript;
|
||||
DebugTo : TSynMemo;
|
||||
procedure OnCompile(Sender: TPSScript);
|
||||
procedure AfterExecute(Sender : TPSScript);
|
||||
function RequireFile(Sender: TObject; const OriginFileName: String;
|
||||
var FileName, OutPut: string): Boolean;
|
||||
procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler);
|
||||
procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
|
||||
procedure OutputMessages;
|
||||
procedure Execute; override;
|
||||
public
|
||||
procedure SetPSScript(Script : string);
|
||||
procedure SetDebug( Strings : TSynMemo );
|
||||
function SetClientInfo : boolean;
|
||||
// function CompilePSScript : boolean;
|
||||
// function
|
||||
constructor Create(CreateSuspended: Boolean);
|
||||
destructor Destroy;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
MufasaTypes,{$ifdef mswindows}windows,{$endif}
|
||||
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
|
||||
|
||||
|
||||
threadvar
|
||||
CurrThread : TMMLPSThread;
|
||||
|
||||
{Some General PS Functions here}
|
||||
procedure Writeln(str : string);
|
||||
begin;
|
||||
if CurrThread.DebugTo <> nil then
|
||||
CurrThread.DebugTo.Lines.Add(Str);
|
||||
//Just overwriting itz.. soz.
|
||||
end;
|
||||
|
||||
function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;
|
||||
var
|
||||
i : integer;
|
||||
begin;
|
||||
Writeln('We have a length of: ' + inttostr(length(v)));
|
||||
Try
|
||||
Result := CurrThread.PSScript.Exec.RunProcPVar(v,CurrThread.PSScript.Exec.GetProc(Procname));
|
||||
Except
|
||||
Writeln('We has some errors :-(');
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
Note to Raymond: For PascalScript, Create it on the .Create,
|
||||
Execute it on the .Execute, and don't forget to Destroy it on .Destroy.
|
||||
|
||||
Furthermore, all the wrappers can be in the unit "implementation" section.
|
||||
Better still to create an .inc for it, otherwise this unit will become huge.
|
||||
(You can even split up the .inc's in stuff like color, bitmap, etc. )
|
||||
|
||||
Also, don't add PS to this unit, but make a seperate unit for it.
|
||||
Unit "MMLPSThread", perhaps?
|
||||
|
||||
See the TestUnit for use of this thread, it's pretty straightforward.
|
||||
|
||||
It may also be wise to turn the "Importing of wrappers" into an include as
|
||||
well, it will really make the unit more straightforward to use and read.
|
||||
}
|
||||
|
||||
|
||||
constructor TMMLPSThread.Create(CreateSuspended : boolean);
|
||||
begin
|
||||
if Client <> nil then
|
||||
Writeln('ThreadClient seems to be set, so not recreating it.') //reset client to defaults?
|
||||
//ThreadClient.ResetToDefaults
|
||||
else
|
||||
Client := TClient.Create;
|
||||
if PSScript <> nil then
|
||||
PSScript.Free;
|
||||
// Create Stuff here
|
||||
PSScript := TPSScript.Create(nil);
|
||||
PSScript.UsePreProcessor:= True;
|
||||
PSScript.OnNeedFile := @RequireFile;
|
||||
|
||||
|
||||
PSScript.OnCompile:= @OnCompile;
|
||||
PSScript.OnCompImport:= @OnCompImport;
|
||||
PSScript.OnExecImport:= @OnExecImport;
|
||||
PSScript.OnAfterExecute:= @AfterExecute;
|
||||
{$IFDEF CPU386 }
|
||||
PSScript.Defines.Add ('CPU386');
|
||||
{$ENDIF }
|
||||
PSScript.Defines.Add ('MUFASA');
|
||||
PSScript.Defines.Add ('COGAT');
|
||||
PSScript.Defines.Add ('RAYMONDPOWNS');
|
||||
{$IFDEF MSWINDOWS }
|
||||
PSScript.Defines.Add ('MSWINDOWS');
|
||||
PSScript.Defines.Add ('WIN32');
|
||||
PSScript.Defines.Add ('WINDOWS');
|
||||
{$ENDIF }
|
||||
{$IFDEF LINUX }
|
||||
PSScript.Defines.Add ('LINUX');
|
||||
{$ENDIF }
|
||||
FreeOnTerminate := True;
|
||||
inherited Create(CreateSuspended);
|
||||
end;
|
||||
|
||||
destructor TMMLPSThread.Destroy;
|
||||
begin
|
||||
Client.Free;
|
||||
PSScript.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TMMLPSThread.OnCompile(Sender: TPSScript);
|
||||
begin
|
||||
//Here we add all the initalizing, of BMPArray etc
|
||||
Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
|
||||
Sender.AddFunction(@Writeln,'procedure writeln(s : string);');
|
||||
//Also the functions get added into the engine, right here.
|
||||
end;
|
||||
|
||||
procedure TMMLPSThread.AfterExecute(Sender: TPSScript);
|
||||
begin
|
||||
//Here we add all the Script-freeing-leftovers (like BMParray etc)
|
||||
end;
|
||||
|
||||
function TMMLPSThread.RequireFile(Sender: TObject;
|
||||
const OriginFileName: String; var FileName, OutPut: string): Boolean;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TMMLPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler);
|
||||
begin
|
||||
SIRegister_Std(x);
|
||||
SIRegister_Controls(x);
|
||||
SIRegister_Classes(x, true);
|
||||
SIRegister_Graphics(x, true);
|
||||
SIRegister_stdctrls(x);
|
||||
SIRegister_Forms(x);
|
||||
SIRegister_ExtCtrls(x);
|
||||
end;
|
||||
|
||||
procedure TMMLPSThread.OnExecImport(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;
|
||||
|
||||
procedure TMMLPSThread.OutputMessages;
|
||||
var
|
||||
l: Longint;
|
||||
b: Boolean;
|
||||
begin
|
||||
b := False;
|
||||
for l := 0 to PSScript.CompilerMessageCount - 1 do
|
||||
begin
|
||||
Writeln(PSScript.CompilerErrorToStr(l));
|
||||
if (not b) and (PSScript.CompilerMessages[l] is TIFPSPascalCompilerError) then
|
||||
begin
|
||||
b := True;
|
||||
// FormMain.CurrSynEdit.SelStart := PSScript.CompilerMessages[l].Pos;
|
||||
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMMLPSThread.Execute;
|
||||
var
|
||||
time, i, ii: Integer;
|
||||
begin;
|
||||
CurrThread := Self;
|
||||
time := GetTickCount;
|
||||
try
|
||||
if PSScript.Compile then
|
||||
begin
|
||||
OutputMessages;
|
||||
Writeln('Compiled succesfully in ' + IntToStr(GetTickCount - time) + ' ms.');
|
||||
// if not (ScriptState = SCompiling) then
|
||||
if not PSScript.Execute then
|
||||
begin
|
||||
// FormMain.CurrSynEdit.SelStart := Script.PSScript.ExecErrorPosition;
|
||||
Writeln(PSScript.ExecErrorToString +' at '+Inttostr(PSScript.ExecErrorProcNo)+'.'
|
||||
+Inttostr(PSScript.ExecErrorByteCodePosition));
|
||||
end else Writeln('Succesfully executed');
|
||||
end else
|
||||
begin
|
||||
OutputMessages;
|
||||
Writeln('Compiling failed');
|
||||
end;
|
||||
except
|
||||
on E : Exception do
|
||||
Writeln('Error: ' + E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMMLPSThread.SetPSScript(Script: string);
|
||||
begin
|
||||
PSScript.Script.Text:= Script;
|
||||
end;
|
||||
|
||||
procedure TMMLPSThread.SetDebug(Strings: TSynMemo);
|
||||
begin
|
||||
DebugTo := Strings;
|
||||
end;
|
||||
|
||||
function TMMLPSThread.SetClientInfo: boolean;
|
||||
begin
|
||||
//Set the client handle, etc
|
||||
end;
|
||||
|
||||
{ Include stuff here? }
|
||||
|
||||
//{$I inc/colors.inc}
|
||||
//{$I inc/bitmaps.inc}
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
unit mmlpsthread;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,SynMemo;
|
||||
|
||||
type
|
||||
|
||||
{ TMMLPSThread }
|
||||
|
||||
TMMLPSThread = class(TThread)
|
||||
protected
|
||||
// PSScript : TPSScript;
|
||||
// PSClient : TPSScript;
|
||||
// Client: TClient;
|
||||
// DebugTo : TStrings;
|
||||
Client : TClient;
|
||||
PSScript : TPSScript;
|
||||
DebugTo : TSynMemo;
|
||||
procedure OnCompile(Sender: TPSScript);
|
||||
procedure AfterExecute(Sender : TPSScript);
|
||||
function RequireFile(Sender: TObject; const OriginFileName: String;
|
||||
var FileName, OutPut: string): Boolean;
|
||||
procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler);
|
||||
procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
|
||||
procedure OutputMessages;
|
||||
procedure Execute; override;
|
||||
public
|
||||
procedure SetPSScript(Script : string);
|
||||
procedure SetDebug( Strings : TSynMemo );
|
||||
function SetClientInfo : boolean;
|
||||
// function CompilePSScript : boolean;
|
||||
// function
|
||||
constructor Create(CreateSuspended: Boolean);
|
||||
destructor Destroy;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
MufasaTypes,{$ifdef mswindows}windows,{$endif}
|
||||
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
|
||||
lclintf;
|
||||
|
||||
|
||||
threadvar
|
||||
CurrThread : TMMLPSThread;
|
||||
|
||||
{Some General PS Functions here}
|
||||
procedure Writeln(str : string);
|
||||
begin;
|
||||
if CurrThread.DebugTo <> nil then
|
||||
CurrThread.DebugTo.Lines.Add(Str);
|
||||
//Just overwriting itz.. soz.
|
||||
end;
|
||||
|
||||
function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;
|
||||
var
|
||||
i : integer;
|
||||
begin;
|
||||
Writeln('We have a length of: ' + inttostr(length(v)));
|
||||
Try
|
||||
Result := CurrThread.PSScript.Exec.RunProcPVar(v,CurrThread.PSScript.Exec.GetProc(Procname));
|
||||
Except
|
||||
Writeln('We has some errors :-(');
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
Note to Raymond: For PascalScript, Create it on the .Create,
|
||||
Execute it on the .Execute, and don't forget to Destroy it on .Destroy.
|
||||
|
||||
Furthermore, all the wrappers can be in the unit "implementation" section.
|
||||
Better still to create an .inc for it, otherwise this unit will become huge.
|
||||
(You can even split up the .inc's in stuff like color, bitmap, etc. )
|
||||
|
||||
Also, don't add PS to this unit, but make a seperate unit for it.
|
||||
Unit "MMLPSThread", perhaps?
|
||||
|
||||
See the TestUnit for use of this thread, it's pretty straightforward.
|
||||
|
||||
It may also be wise to turn the "Importing of wrappers" into an include as
|
||||
well, it will really make the unit more straightforward to use and read.
|
||||
}
|
||||
|
||||
|
||||
constructor TMMLPSThread.Create(CreateSuspended : boolean);
|
||||
begin
|
||||
if Client <> nil then
|
||||
Writeln('ThreadClient seems to be set, so not recreating it.') //reset client to defaults?
|
||||
//ThreadClient.ResetToDefaults
|
||||
else
|
||||
Client := TClient.Create;
|
||||
if PSScript <> nil then
|
||||
PSScript.Free;
|
||||
// Create Stuff here
|
||||
PSScript := TPSScript.Create(nil);
|
||||
PSScript.UsePreProcessor:= True;
|
||||
PSScript.OnNeedFile := @RequireFile;
|
||||
|
||||
|
||||
PSScript.OnCompile:= @OnCompile;
|
||||
PSScript.OnCompImport:= @OnCompImport;
|
||||
PSScript.OnExecImport:= @OnExecImport;
|
||||
PSScript.OnAfterExecute:= @AfterExecute;
|
||||
{$IFDEF CPU386 }
|
||||
PSScript.Defines.Add ('CPU386');
|
||||
{$ENDIF }
|
||||
PSScript.Defines.Add ('MUFASA');
|
||||
PSScript.Defines.Add ('COGAT');
|
||||
PSScript.Defines.Add ('RAYMONDPOWNS');
|
||||
{$IFDEF MSWINDOWS }
|
||||
PSScript.Defines.Add ('MSWINDOWS');
|
||||
PSScript.Defines.Add ('WIN32');
|
||||
PSScript.Defines.Add ('WINDOWS');
|
||||
{$ENDIF }
|
||||
{$IFDEF LINUX }
|
||||
PSScript.Defines.Add ('LINUX');
|
||||
{$ENDIF }
|
||||
FreeOnTerminate := True;
|
||||
inherited Create(CreateSuspended);
|
||||
end;
|
||||
|
||||
destructor TMMLPSThread.Destroy;
|
||||
begin
|
||||
Client.Free;
|
||||
PSScript.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TMMLPSThread.OnCompile(Sender: TPSScript);
|
||||
begin
|
||||
//Here we add all the initalizing, of BMPArray etc
|
||||
Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
|
||||
Sender.AddFunction(@Writeln,'procedure writeln(s : string);');
|
||||
//Also the functions get added into the engine, right here.
|
||||
end;
|
||||
|
||||
procedure TMMLPSThread.AfterExecute(Sender: TPSScript);
|
||||
begin
|
||||
//Here we add all the Script-freeing-leftovers (like BMParray etc)
|
||||
end;
|
||||
|
||||
function TMMLPSThread.RequireFile(Sender: TObject;
|
||||
const OriginFileName: String; var FileName, OutPut: string): Boolean;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TMMLPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler);
|
||||
begin
|
||||
SIRegister_Std(x);
|
||||
SIRegister_Controls(x);
|
||||
SIRegister_Classes(x, true);
|
||||
SIRegister_Graphics(x, true);
|
||||
SIRegister_stdctrls(x);
|
||||
SIRegister_Forms(x);
|
||||
SIRegister_ExtCtrls(x);
|
||||
end;
|
||||
|
||||
procedure TMMLPSThread.OnExecImport(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;
|
||||
|
||||
procedure TMMLPSThread.OutputMessages;
|
||||
var
|
||||
l: Longint;
|
||||
b: Boolean;
|
||||
begin
|
||||
b := False;
|
||||
for l := 0 to PSScript.CompilerMessageCount - 1 do
|
||||
begin
|
||||
Writeln(PSScript.CompilerErrorToStr(l));
|
||||
if (not b) and (PSScript.CompilerMessages[l] is TIFPSPascalCompilerError) then
|
||||
begin
|
||||
b := True;
|
||||
// FormMain.CurrSynEdit.SelStart := PSScript.CompilerMessages[l].Pos;
|
||||
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMMLPSThread.Execute;
|
||||
var
|
||||
time, i, ii: Integer;
|
||||
begin;
|
||||
CurrThread := Self;
|
||||
time := lclintf.GetTickCount;
|
||||
try
|
||||
if PSScript.Compile then
|
||||
begin
|
||||
OutputMessages;
|
||||
Writeln('Compiled succesfully in ' + IntToStr(GetTickCount - time) + ' ms.');
|
||||
// if not (ScriptState = SCompiling) then
|
||||
if not PSScript.Execute then
|
||||
begin
|
||||
// FormMain.CurrSynEdit.SelStart := Script.PSScript.ExecErrorPosition;
|
||||
Writeln(PSScript.ExecErrorToString +' at '+Inttostr(PSScript.ExecErrorProcNo)+'.'
|
||||
+Inttostr(PSScript.ExecErrorByteCodePosition));
|
||||
end else Writeln('Succesfully executed');
|
||||
end else
|
||||
begin
|
||||
OutputMessages;
|
||||
Writeln('Compiling failed');
|
||||
end;
|
||||
except
|
||||
on E : Exception do
|
||||
Writeln('Error: ' + E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMMLPSThread.SetPSScript(Script: string);
|
||||
begin
|
||||
PSScript.Script.Text:= Script;
|
||||
end;
|
||||
|
||||
procedure TMMLPSThread.SetDebug(Strings: TSynMemo);
|
||||
begin
|
||||
DebugTo := Strings;
|
||||
end;
|
||||
|
||||
function TMMLPSThread.SetClientInfo: boolean;
|
||||
begin
|
||||
//Set the client handle, etc
|
||||
end;
|
||||
|
||||
{ Include stuff here? }
|
||||
|
||||
//{$I inc/colors.inc}
|
||||
//{$I inc/bitmaps.inc}
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user