diff --git a/Projects/SAMufasaGUI/project1.lpi b/Projects/SAMufasaGUI/project1.lpi
index c329bdc..c9d5315 100644
--- a/Projects/SAMufasaGUI/project1.lpi
+++ b/Projects/SAMufasaGUI/project1.lpi
@@ -33,15 +33,15 @@
-
+
-
+
-
+
@@ -170,10 +170,10 @@
-
-
-
-
+
+
+
+
@@ -302,10 +302,10 @@
-
+
-
+
@@ -315,7 +315,7 @@
-
+
@@ -331,16 +331,16 @@
-
+
-
-
-
-
+
+
+
+
@@ -375,10 +375,10 @@
-
-
+
+
-
+
@@ -394,7 +394,7 @@
-
+
@@ -406,10 +406,10 @@
-
-
-
-
+
+
+
+
@@ -417,17 +417,13 @@
-
-
-
-
@@ -468,9 +464,7 @@
-
-
@@ -484,9 +478,7 @@
-
-
@@ -527,9 +519,7 @@
-
-
@@ -541,18 +531,16 @@
-
-
-
-
-
-
+
+
+
+
@@ -565,17 +553,15 @@
-
-
+
-
-
+
@@ -687,17 +673,13 @@
-
-
-
-
@@ -712,14 +694,14 @@
-
+
-
-
+
+
@@ -732,9 +714,7 @@
-
-
@@ -774,8 +754,8 @@
-
-
+
+
@@ -812,184 +792,189 @@
-
-
-
+
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
diff --git a/Projects/SAMufasaGUI/project1.lpr b/Projects/SAMufasaGUI/project1.lpr
index 734b80f..a0f38f7 100644
--- a/Projects/SAMufasaGUI/project1.lpr
+++ b/Projects/SAMufasaGUI/project1.lpr
@@ -8,7 +8,7 @@ uses
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, LResources, Window, files, MufasaTypes, Client, TestUnit, finder,
- MMLThread, mmlpsthread, bitmaps, colour_conv, plugins;
+ MMLThread, mmlpsthread, bitmaps, colour_conv, plugins, DTM;
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas
index 775a65b..387d251 100644
--- a/Units/MMLAddon/mmlpsthread.pas
+++ b/Units/MMLAddon/mmlpsthread.pas
@@ -1,282 +1,280 @@
-unit mmlpsthread;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
- Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,stdCtrls, Plugins,uPSPreProcessor;
-
-type
-
- { TMMLPSThread }
-
- TMMLPSThread = class(TThread)
- procedure PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
- Parser: TPSPascalPreProcessorParser; const Active: Boolean;
- const DirectiveName, DirectiveParam: string; var Continue: Boolean);
- protected
- PSScript : TPSScript;
- DebugTo : TMemo;
- PluginsToload : Array of integer;
- 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 OnThreadTerminate(Sender: TObject);
- procedure Execute; override;
- public
- Client : TClient;
- procedure SetPSScript(Script : string);
- procedure SetDebug( Strings : TMemo );
- constructor Create(CreateSuspended: Boolean);
- destructor Destroy; override;
- 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
- Graphics, //For Graphics types
- math, //Maths!
- lclintf; // for GetTickCount and others.
-
-
-threadvar
- CurrThread : TMMLPSThread;
-
-{Some General PS Functions here}
-procedure psWriteln(str : string);
-begin
- {$IFNDEF MSWINDOWS}
- writeln(str);
- {$ELSE}
- if CurrThread.DebugTo <> nil then
- CurrThread.DebugTo.lines.add(str);
-
- {$ENDIF}
- //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
- SetLength(PluginsToLoad,0);
- Client := TClient.Create;
- PSScript := TPSScript.Create(nil);
- PSScript.UsePreProcessor:= True;
- PSScript.OnNeedFile := @RequireFile;
- PSScript.OnProcessUnknowDirective:=@PSScriptProcessUnknowDirective;
- PSScript.OnCompile:= @OnCompile;
- PSScript.OnCompImport:= @OnCompImport;
- PSScript.OnExecImport:= @OnExecImport;
- PSScript.OnAfterExecute:= @AfterExecute;
-
- // Set some defines
- {$I PSInc/psdefines.inc}
-
-
- FreeOnTerminate := True;
- Self.OnTerminate := @Self.OnThreadTerminate;
- inherited Create(CreateSuspended);
-end;
-
-procedure TMMLPSThread.OnThreadTerminate(Sender: TObject);
-begin
-// Writeln('Terminating the thread');
-end;
-
-destructor TMMLPSThread.Destroy;
-begin
- SetLength(PluginsToLoad,0);
- Client.Free;
- PSScript.Free;
- inherited;
-end;
-
-// include PS wrappers
-{$I PSInc/Wrappers/other.inc}
-{$I PSInc/Wrappers/bitmap.inc}
-{$I PSInc/Wrappers/colour.inc}
-{$I PSInc/Wrappers/math.inc}
-{$I PSInc/Wrappers/mouse.inc}
-
-
-
-procedure TMMLPSThread.PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
- Parser: TPSPascalPreProcessorParser; const Active: Boolean;
- const DirectiveName, DirectiveParam: string; var Continue: Boolean);
-var
- TempNum : integer;
- I,II : integer;
-begin
- if DirectiveName= 'LOADDLL' then
- if DirectiveParam <> '' then
- begin;
- TempNum := PluginsGlob.LoadPlugin(DirectiveParam);
- if TempNum < 0 then
- Writeln(Format('Your DLL %s has not been found',[DirectiveParam]))
- else
- begin;
- for i := High(PluginsToLoad) downto 0 do
- if PluginsToLoad[i] = TempNum then
- Exit;
- SetLength(PluginsToLoad,Length(PluginsToLoad)+1);
- PluginsToLoad[High(PluginsToLoad)] := TempNum;
- end;
- end;
- Continue:= True;
-end;
-
-procedure TMMLPSThread.OnCompile(Sender: TPSScript);
-var
- i,ii : integer;
-begin
- for i := high(PluginsToLoad) downto 0 do
- for ii := 0 to PluginsGlob.MPlugins[PluginsToLoad[i]].MethodLen - 1 do
- PSScript.AddFunctionEx(PluginsGlob.MPlugins[PluginsToLoad[i]].Methods[i].FuncPtr,
- PluginsGlob.MPlugins[PluginsToLoad[i]].Methods[i].FuncStr, cdStdCall);
- // Here we add all the functions to the engine.
- {$I PSInc/pscompile.inc}
-end;
-
-procedure TMMLPSThread.AfterExecute(Sender: TPSScript);
-begin
- //Here we add all the Script-freeing-leftovers (like BMParray etc)
- // ^ This will all be done with Client.Destroy;
-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
- psWriteln(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;
- psWriteln('Compiled succesfully in ' + IntToStr(GetTickCount - time) + ' ms.');
-// if not (ScriptState = SCompiling) then
- if not PSScript.Execute then
- begin
-// FormMain.CurrSynEdit.SelStart := Script.PSScript.ExecErrorPosition;
- psWriteln(PSScript.ExecErrorToString +' at '+Inttostr(PSScript.ExecErrorProcNo)+'.'
- +Inttostr(PSScript.ExecErrorByteCodePosition));
- end else psWriteln('Succesfully executed');
- end else
- begin
- OutputMessages;
- psWriteln('Compiling failed');
- end;
- except
- on E : Exception do
- psWriteln('Error: ' + E.Message);
- end;
-end;
-
-procedure TMMLPSThread.SetPSScript(Script: string);
-begin
- PSScript.Script.Text:= Script;
-end;
-
-procedure TMMLPSThread.SetDebug(Strings: TMemo);
-begin
- DebugTo := Strings;
-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,stdCtrls, Plugins,uPSPreProcessor;
+
+type
+
+ { TMMLPSThread }
+
+ TMMLPSThread = class(TThread)
+ procedure PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
+ Parser: TPSPascalPreProcessorParser; const Active: Boolean;
+ const DirectiveName, DirectiveParam: string; var Continue: Boolean);
+ protected
+ PSScript : TPSScript;
+ DebugTo : TMemo;
+ PluginsToload : Array of integer;
+ 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 OnThreadTerminate(Sender: TObject);
+ procedure Execute; override;
+ public
+ Client : TClient;
+ procedure SetPSScript(Script : string);
+ procedure SetDebug( Strings : TMemo );
+ constructor Create(CreateSuspended: Boolean);
+ destructor Destroy; override;
+ 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
+ Graphics, //For Graphics types
+ math, //Maths!
+ lclintf; // for GetTickCount and others.
+
+
+threadvar
+ CurrThread : TMMLPSThread;
+
+{Some General PS Functions here}
+procedure psWriteln(str : string);
+begin
+ {$IFNDEF MSWINDOWS}
+ writeln(str);
+ {$ELSE}
+ if CurrThread.DebugTo <> nil then
+ CurrThread.DebugTo.lines.add(str);
+ {$ENDIF}
+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
+ SetLength(PluginsToLoad,0);
+ Client := TClient.Create;
+ PSScript := TPSScript.Create(nil);
+ PSScript.UsePreProcessor:= True;
+ PSScript.OnNeedFile := @RequireFile;
+ PSScript.OnProcessUnknowDirective:=@PSScriptProcessUnknowDirective;
+ PSScript.OnCompile:= @OnCompile;
+ PSScript.OnCompImport:= @OnCompImport;
+ PSScript.OnExecImport:= @OnExecImport;
+ PSScript.OnAfterExecute:= @AfterExecute;
+
+ // Set some defines
+ {$I PSInc/psdefines.inc}
+
+
+ FreeOnTerminate := True;
+ Self.OnTerminate := @Self.OnThreadTerminate;
+ inherited Create(CreateSuspended);
+end;
+
+procedure TMMLPSThread.OnThreadTerminate(Sender: TObject);
+begin
+// Writeln('Terminating the thread');
+end;
+
+destructor TMMLPSThread.Destroy;
+begin
+ SetLength(PluginsToLoad,0);
+ Client.Free;
+ PSScript.Free;
+ inherited;
+end;
+
+// include PS wrappers
+{$I PSInc/Wrappers/other.inc}
+{$I PSInc/Wrappers/bitmap.inc}
+{$I PSInc/Wrappers/colour.inc}
+{$I PSInc/Wrappers/math.inc}
+{$I PSInc/Wrappers/mouse.inc}
+
+
+
+procedure TMMLPSThread.PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
+ Parser: TPSPascalPreProcessorParser; const Active: Boolean;
+ const DirectiveName, DirectiveParam: string; var Continue: Boolean);
+var
+ TempNum : integer;
+ I,II : integer;
+begin
+ if DirectiveName= 'LOADDLL' then
+ if DirectiveParam <> '' then
+ begin;
+ TempNum := PluginsGlob.LoadPlugin(DirectiveParam);
+ if TempNum < 0 then
+ Writeln(Format('Your DLL %s has not been found',[DirectiveParam]))
+ else
+ begin;
+ for i := High(PluginsToLoad) downto 0 do
+ if PluginsToLoad[i] = TempNum then
+ Exit;
+ SetLength(PluginsToLoad,Length(PluginsToLoad)+1);
+ PluginsToLoad[High(PluginsToLoad)] := TempNum;
+ end;
+ end;
+ Continue:= True;
+end;
+
+procedure TMMLPSThread.OnCompile(Sender: TPSScript);
+var
+ i,ii : integer;
+begin
+ for i := high(PluginsToLoad) downto 0 do
+ for ii := 0 to PluginsGlob.MPlugins[PluginsToLoad[i]].MethodLen - 1 do
+ PSScript.AddFunctionEx(PluginsGlob.MPlugins[PluginsToLoad[i]].Methods[i].FuncPtr,
+ PluginsGlob.MPlugins[PluginsToLoad[i]].Methods[i].FuncStr, cdStdCall);
+ // Here we add all the functions to the engine.
+ {$I PSInc/pscompile.inc}
+end;
+
+procedure TMMLPSThread.AfterExecute(Sender: TPSScript);
+begin
+ //Here we add all the Script-freeing-leftovers (like BMParray etc)
+ // ^ This will all be done with Client.Destroy;
+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
+ psWriteln(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;
+ psWriteln('Compiled succesfully in ' + IntToStr(GetTickCount - time) + ' ms.');
+// if not (ScriptState = SCompiling) then
+ if not PSScript.Execute then
+ begin
+// FormMain.CurrSynEdit.SelStart := Script.PSScript.ExecErrorPosition;
+ psWriteln(PSScript.ExecErrorToString +' at '+Inttostr(PSScript.ExecErrorProcNo)+'.'
+ +Inttostr(PSScript.ExecErrorByteCodePosition));
+ end else psWriteln('Succesfully executed');
+ end else
+ begin
+ OutputMessages;
+ psWriteln('Compiling failed');
+ end;
+ except
+ on E : Exception do
+ psWriteln('Error: ' + E.Message);
+ end;
+end;
+
+procedure TMMLPSThread.SetPSScript(Script: string);
+begin
+ PSScript.Script.Text:= Script;
+end;
+
+procedure TMMLPSThread.SetDebug(Strings: TMemo);
+begin
+ DebugTo := Strings;
+end;
+
+
+{ Include stuff here? }
+
+//{$I inc/colors.inc}
+//{$I inc/bitmaps.inc}
+
+
+end.
+
+