diff --git a/branches/script-component/Projects/SAMufasaGUI/framescript.lfm b/branches/script-component/Projects/SAMufasaGUI/framescript.lfm
index 9fdb939..e9a8f73 100644
--- a/branches/script-component/Projects/SAMufasaGUI/framescript.lfm
+++ b/branches/script-component/Projects/SAMufasaGUI/framescript.lfm
@@ -25,7 +25,7 @@ object ScriptFrame: TScriptFrame
OnDragDrop = SynEditDragDrop
OnDragOver = SynEditDragOver
OnKeyDown = SynEditKeyDown
- Gutter.Width = 57
+ Gutter.Width = 53
Gutter.MouseActions = <
item
Shift = []
@@ -602,7 +602,7 @@ object ScriptFrame: TScriptFrame
Width = 23
end
object TSynGutterLineNumber
- Width = 17
+ Width = 13
MouseActions = <>
MarkupInfo.Background = clBtnFace
MarkupInfo.Foreground = clNone
diff --git a/branches/script-component/Projects/SAMufasaGUI/framescript.lrs b/branches/script-component/Projects/SAMufasaGUI/framescript.lrs
index 915e204..9d4bdad 100644
--- a/branches/script-component/Projects/SAMufasaGUI/framescript.lrs
+++ b/branches/script-component/Projects/SAMufasaGUI/framescript.lrs
@@ -1,3 +1,5 @@
+{ This is an automatically generated lazarus resource file }
+
LazarusResources.Add('TScriptFrame','FORMDATA',[
'TPF0'#12'TScriptFrame'#11'ScriptFrame'#4'Left'#2#0#6'Height'#3'H'#1#3'Top'#2
+#0#5'Width'#3#141#1#12'ClientHeight'#3'H'#1#11'ClientWidth'#3#141#1#8'TabOrd'
@@ -7,7 +9,7 @@ LazarusResources.Add('TScriptFrame','FORMDATA',[
+'h'#7#7'fpFixed'#12'Font.Quality'#7#16'fqNonAntialiased'#11'ParentColor'#8#10
+'ParentFont'#8#9'PopupMenu'#7#17'Form1.ScriptPopup'#8'TabOrder'#2#0#10'OnDra'
+'gDrop'#7#15'SynEditDragDrop'#10'OnDragOver'#7#15'SynEditDragOver'#9'OnKeyDo'
- +'wn'#7#14'SynEditKeyDown'#12'Gutter.Width'#2'9'#19'Gutter.MouseActions'#14#1
+ +'wn'#7#14'SynEditKeyDown'#12'Gutter.Width'#2'5'#19'Gutter.MouseActions'#14#1
+#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'cc'
+'Any'#8'ClickDir'#7#6'cdDown'#7'Command'#2#13#9'MoveCaret'#8#6'Option'#2#0#8
+'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#7'mbRight'#10
@@ -119,7 +121,7 @@ LazarusResources.Add('TScriptFrame','FORMDATA',[
+'d'#7#25'SynEditProcessUserCommand'#19'OnSpecialLineColors'#7#24'SynEditSpec'
+'ialLineColors'#14'OnStatusChange'#7#19'SynEditStatusChange'#0#244#18'TSynGu'
+'tterPartList'#0#0#15'TSynGutterMarks'#0#5'Width'#2#23#0#0#20'TSynGutterLine'
- +'Number'#0#5'Width'#2#17#12'MouseActions'#14#0#21'MarkupInfo.Background'#7#9
+ +'Number'#0#5'Width'#2#13#12'MouseActions'#14#0#21'MarkupInfo.Background'#7#9
+'clBtnFace'#21'MarkupInfo.Foreground'#7#6'clNone'#10'DigitCount'#2#2#30'Show'
+'OnlyLineNumbersMultiplesOf'#2#1#9'ZeroStart'#8#12'LeadingZeros'#8#0#0#17'TS'
+'ynGutterChanges'#0#5'Width'#2#4#13'ModifiedColor'#4#252#233#0#0#10'SavedCol'
diff --git a/branches/script-component/Projects/SAMufasaGUI/framescript.pas b/branches/script-component/Projects/SAMufasaGUI/framescript.pas
index 4abaf30..d52e966 100644
--- a/branches/script-component/Projects/SAMufasaGUI/framescript.pas
+++ b/branches/script-component/Projects/SAMufasaGUI/framescript.pas
@@ -69,7 +69,7 @@ type
ScriptName : string;//The name of the currently opened/saved file.
ScriptDefault : string;//The default script e.g. program new; begin end.
ScriptChanged : boolean;//We need this for that little * (edited star).
- ScriptThread : TMMLPSThread;//Just one thread for now..
+ ScriptThread : TMThread;//Just one thread for now..
FScriptState : TScriptState;//Stores the ScriptState, if you want the Run/Pause/Start buttons to change accordingly, acces through Form1
procedure undo;
procedure redo;
@@ -353,4 +353,4 @@ initialization
{$I framescript.lrs}
end.
-
+
\ No newline at end of file
diff --git a/branches/script-component/Projects/SAMufasaGUI/project1.lpi b/branches/script-component/Projects/SAMufasaGUI/project1.lpi
index 807a915..e6aca29 100644
--- a/branches/script-component/Projects/SAMufasaGUI/project1.lpi
+++ b/branches/script-component/Projects/SAMufasaGUI/project1.lpi
@@ -10,7 +10,7 @@
-
+
@@ -139,9 +139,11 @@
-
-
+
+
+
+
@@ -189,7 +191,7 @@
-
+
@@ -264,9 +266,9 @@
-
-
-
+
+
+
@@ -348,7 +350,7 @@
-
+
@@ -493,9 +495,11 @@
-
-
+
+
+
+
@@ -589,7 +593,7 @@
-
+
@@ -628,7 +632,7 @@
-
+
@@ -642,7 +646,7 @@
-
+
@@ -657,7 +661,7 @@
-
+
@@ -705,11 +709,9 @@
-
+
-
-
@@ -764,9 +766,9 @@
-
-
-
+
+
+
@@ -785,13 +787,13 @@
-
+
-
+
@@ -841,7 +843,7 @@
-
+
@@ -855,7 +857,7 @@
-
+
@@ -886,9 +888,11 @@
-
-
+
+
+
+
@@ -933,21 +937,21 @@
-
+
-
+
-
+
@@ -957,7 +961,7 @@
-
+
@@ -971,7 +975,7 @@
-
+
@@ -1003,7 +1007,7 @@
-
+
@@ -1034,14 +1038,14 @@
-
+
-
+
@@ -1538,9 +1542,7 @@
-
-
@@ -1589,7 +1591,7 @@
-
+
@@ -1616,9 +1618,7 @@
-
-
@@ -1646,7 +1646,7 @@
-
+
@@ -1704,10 +1704,10 @@
-
-
-
-
+
+
+
+
@@ -1723,7 +1723,7 @@
-
+
@@ -1734,7 +1734,7 @@
-
+
@@ -1855,7 +1855,7 @@
-
+
@@ -1893,7 +1893,7 @@
-
+
@@ -1950,7 +1950,7 @@
-
+
@@ -1999,7 +1999,7 @@
-
+
@@ -2007,8 +2007,8 @@
-
-
+
+
@@ -2023,8 +2023,8 @@
-
-
+
+
@@ -2047,7 +2047,7 @@
-
+
@@ -2060,8 +2060,8 @@
-
-
+
+
@@ -2082,131 +2082,129 @@
-
-
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
diff --git a/branches/script-component/Projects/SAMufasaGUI/testunit.lfm b/branches/script-component/Projects/SAMufasaGUI/testunit.lfm
index e19d125..f08b393 100644
--- a/branches/script-component/Projects/SAMufasaGUI/testunit.lfm
+++ b/branches/script-component/Projects/SAMufasaGUI/testunit.lfm
@@ -1,7 +1,7 @@
object Form1: TForm1
- Left = 1343
+ Left = 593
Height = 557
- Top = 181
+ Top = 321
Width = 734
ActiveControl = ScriptPanel
Caption = 'THA FUKING SIMBA'
diff --git a/branches/script-component/Projects/SAMufasaGUI/testunit.lrs b/branches/script-component/Projects/SAMufasaGUI/testunit.lrs
index 6839c02..44be78d 100644
--- a/branches/script-component/Projects/SAMufasaGUI/testunit.lrs
+++ b/branches/script-component/Projects/SAMufasaGUI/testunit.lrs
@@ -1,10 +1,10 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'?'#5#6'Height'#3'-'#2#3'Top'#3#181#0#5'Wi'
- +'dth'#3#222#2#13'ActiveControl'#7#11'ScriptPanel'#7'Caption'#6#16'THA FUKING'
- +' SIMBA'#12'ClientHeight'#3#20#2#11'ClientWidth'#3#222#2#10'KeyPreview'#9#4
- +'Menu'#7#8'MainMenu'#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#9
+ 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'Q'#2#6'Height'#3'-'#2#3'Top'#3'A'#1#5'Wid'
+ +'th'#3#222#2#13'ActiveControl'#7#11'ScriptPanel'#7'Caption'#6#16'THA FUKING '
+ +'SIMBA'#12'ClientHeight'#3#20#2#11'ClientWidth'#3#222#2#10'KeyPreview'#9#4'M'
+ +'enu'#7#8'MainMenu'#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#9
+'OnDestroy'#7#11'FormDestroy'#10'OnShortCut'#7#13'FormShortCuts'#8'Position'
+#7#14'poScreenCenter'#10'LCLVersion'#6#6'0.9.29'#7'Visible'#9#0#8'TToolBar'#8
+'ToolBar1'#4'Left'#2#0#6'Height'#2#24#3'Top'#2#0#5'Width'#3#222#2#7'Caption'
diff --git a/branches/script-component/Projects/SAMufasaGUI/testunit.pas b/branches/script-component/Projects/SAMufasaGUI/testunit.pas
index f344a3d..14ac0c1 100644
--- a/branches/script-component/Projects/SAMufasaGUI/testunit.pas
+++ b/branches/script-component/Projects/SAMufasaGUI/testunit.pas
@@ -533,12 +533,12 @@ begin
PluginsPath := LoadSettingDef('Settings/Plugins/Path', ExpandFileName(MainDir + DS + '..' + DS + '..'+ DS + 'Plugins'+ DS));
ScriptErrorLine:= -1;
CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread;
- ScriptThread := TMMLPSThread.Create(True,@CurrentSyncInfo,PluginsPath);
+ ScriptThread := TPSThread.Create(True,@CurrentSyncInfo,PluginsPath);
{$IFNDEF TERMINALWRITELN}
ScriptThread.SetDebug(@formWriteln);
ScriptThread.DebugMemo := Self.Memo1;
{$ENDIF}
- ScriptThread.SetPSScript(CurrScript.SynEdit.Lines.Text);
+ ScriptThread.SetScript(CurrScript.SynEdit.Lines.Text);
DbgImgInfo.DispSize := @DebugImgForm.DispSize;
DbgImgInfo.ShowForm := @DebugImgForm.ShowDebugImgForm;
DbgImgInfo.ToDrawBitmap:= @DebugImgForm.ToDrawBmp;
@@ -627,13 +627,13 @@ begin
end;
ss_Running:
begin
- ScriptThread.PSScript.Stop;
+ ScriptThread.Terminate;
ScriptState := ss_Stopping;
end;
ss_Paused:
begin
ScriptThread.Resume;
- ScriptThread.PSScript.Stop;
+ ScriptThread.Terminate;
ScriptState:= ss_Stopping;
end;
end;
@@ -1436,7 +1436,7 @@ var
begin
if frmFunctionList.FunctionList.Items.Count = 0 then
begin;
- Methods := TMMLPSThread.GetExportedMethods;
+ Methods := TMThread.GetExportedMethods;
Tree := frmFunctionList.FunctionList;
Tree.Items.Clear;
Sections := TStringList.Create;
@@ -1701,7 +1701,7 @@ end;
procedure TForm1.SafeCallThread;
begin
Writeln('Executing : ' + CurrentSyncInfo.MethodName);
- mmlpsthread.CurrThread := TMMLPSTHREAD(CurrentSyncInfo.OldThread);
+ mmlpsthread.CurrThread := TMThread(CurrentSyncInfo.OldThread);
with CurrentSyncInfo.PSScript do
begin;
OnLine:=@OnLinePSScript;
diff --git a/branches/script-component/Units/MMLAddon/PSInc/Wrappers/other.inc b/branches/script-component/Units/MMLAddon/PSInc/Wrappers/other.inc
index 117220e..d07e6a0 100644
--- a/branches/script-component/Units/MMLAddon/PSInc/Wrappers/other.inc
+++ b/branches/script-component/Units/MMLAddon/PSInc/Wrappers/other.inc
@@ -33,7 +33,7 @@ begin
if t > 50 then
begin;
EndTime := GetTickCount + t;
- while (CurrThread.PSScript.Exec.Status = isRunning) and (GetTickCount < EndTime) do
+ while {(CurrThread.PSScript.Exec.Status = isRunning) and }(GetTickCount < EndTime) do
Sleep(16);
end else
begin
@@ -104,7 +104,7 @@ end;
procedure TerminateScript;
begin;
- CurrThread.PSScript.Stop;
+ CurrThread.Terminate;
end;
function GetTimeRunning: LongWord;
begin;
diff --git a/branches/script-component/Units/MMLAddon/PSInc/psexportedmethods.inc b/branches/script-component/Units/MMLAddon/PSInc/psexportedmethods.inc
index 0c0e489..72c8735 100644
--- a/branches/script-component/Units/MMLAddon/PSInc/psexportedmethods.inc
+++ b/branches/script-component/Units/MMLAddon/PSInc/psexportedmethods.inc
@@ -21,7 +21,7 @@
psexportedmethods.inc for the Mufasa Macro Library
}
-AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
+//AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
AddFunction(nil,'procedure Writeln(x);'); //We use special function for this
{ DTM }
@@ -97,7 +97,7 @@ AddFunction(@DisplayDebugImgWindow,'procedure DisplayDebugImgWindow(w, h: intege
AddFunction(@DrawBitmapDebugImg,'procedure DrawBitmapDebugImg(bmp: integer);');
AddFunction(@GetDebugBitmap,'function GetDebugBitmap: integer;');
AddFunction(@Random,'function Random(Int: integer): integer;');
-AddFunction(@NewThreadCall,'function NewThreadCall(procname : string) : cardinal');
+//AddFunction(@NewThreadCall,'function NewThreadCall(procname : string) : cardinal');
AddFunction(@ClearDebug,'procedure ClearDebug;');
diff --git a/branches/script-component/Units/MMLAddon/mmlpsthread.pas b/branches/script-component/Units/MMLAddon/mmlpsthread.pas
index 969bfca..d35b341 100644
--- a/branches/script-component/Units/MMLAddon/mmlpsthread.pas
+++ b/branches/script-component/Units/MMLAddon/mmlpsthread.pas
@@ -74,54 +74,74 @@ type
end;
TExpMethodArr = array of TExpMethod;
- TMMLPSThread = class(TThread)
+ TMThread = class(TThread)
+ protected
+ ScriptPath, AppPath, IncludePath, PluginPath, FontPath: string;
+ DebugTo: TWritelnProc;
+ DebugImg : TDbgImgInfo;
+ PluginsToload : array of integer;
+ ExportedMethods : TExpMethodArr;
+
+ procedure HandleError(ErrorAtLine,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType; ErrorModule : string);
+ function ProcessDirective(DirectiveName, DirectiveArgs: string): boolean;
+ function LoadFile(var filename, contents: string): boolean;
+ procedure LoadMethods; virtual; abstract;
+
+ public
+ Client : TClient;
+ StartTime : LongWord;
+ DebugMemo : TMemo;
+
+ SyncInfo : PSyncInfo; //We need this for callthreadsafe
+ ErrorData : PErrorData; //We need this for thread-safety etc
+ OnError : TOnError; //Error handeler
+
+ procedure SetScript(Script : string);
+ procedure SetDebug( writelnProc : TWritelnProc );
+ procedure SetDbgImg( DebugImageInfo : TDbgImgInfo);
+ procedure SetPaths(ScriptP,AppP,IncludeP,PluginP,FontP : string);
+ procedure OnThreadTerminate(Sender: TObject);
+ procedure SetScript(script: string); virtual; abstract;
+ procedure Execute; override; abstract;
+ procedure Terminate; virtual; abstract;
+
+ constructor Create(CreateSuspended: boolean; plugin_dir: string);
+ destructor Destroy; override;
+
+ class function GetExportedMethods : TExpMethodArr;
+ end;
+
+ TPSThread = class(TMThread)
procedure OnProcessDirective(Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser; const Active: Boolean;
const DirectiveName, DirectiveParam: string; var Continue: Boolean);
function PSScriptFindUnknownFile(Sender: TObject;
- const OrginFileName: string; var FileName, Output: string
- ): Boolean;
+ const OrginFileName: string; var FileName, Output: string): Boolean;
procedure PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser; const Active: Boolean;
const DirectiveName, DirectiveParam: string; var Continue: Boolean);
- private
- ScriptPath, AppPath, IncludePath, PluginPath, FontPath: string;
- procedure HandleError(ErrorAtLine,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType; ErrorModule : string);
protected
//DebugTo : TMemo;
- DebugTo: TWritelnProc;
- DebugImg : TDbgImgInfo;
- PluginsToload : Array of integer;
- FOnError : TOnError;
procedure OnCompile(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
- ExportedMethods : TExpMethodArr;
PSScript : TPSScript; // Moved to public, as we can't kill it otherwise.
- Client : TClient;
- StartTime : LongWord;
- DebugMemo : TMemo;
- SyncInfo : PSyncInfo; //We need this for callthreadsafe
- ErrorData : PErrorData; //We need this for thread-safety etc
- property OnError : TOnError read FOnError write FOnError;
- procedure LoadMethods;
- class function GetExportedMethods : TExpMethodArr;
- procedure SetPSScript(Script : string);
- procedure SetDebug( writelnProc : TWritelnProc );
- procedure SetDbgImg( DebugImageInfo : TDbgImgInfo);
- procedure SetPaths(ScriptP,AppP,IncludeP,PluginP,FontP : string);
constructor Create(CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string);
destructor Destroy; override;
+ procedure SetScript(script: string); override;
+ procedure Execute; override;
+ procedure Terminate; override;
end;
+
threadvar
- CurrThread : TMMLPSThread;
+ CurrThread : TMThread;
+
implementation
+
uses
colour_conv,dtmutil,
{$ifdef mswindows}windows,{$endif}
@@ -199,27 +219,166 @@ begin
Stack.SetAnsiString(-1, MakeString(NewTPSVariantIFC(Stack[Stack.Count-2],false)));
end;
-function NewThreadCall(Procname : string) : Cardinal;
-begin;
- result := CurrThread.PSScript.Exec.GetVar(Procname);
+{***implementation TMThread***}
+constructor TMThread.Create(CreateSuspended: boolean; plugin_dir: string);
+begin
+ Client := TClient.Create(plugin_dir);
+ ExportedMethods:= GetExportedMethods;
+ SetLength(PluginsToLoad,0);
+ FreeOnTerminate := True;
+ OnTerminate := @OnThreadTerminate;
+ inherited Create(CreateSuspended);
end;
-function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;
-begin;
- CurrThread.SyncInfo^.MethodName:= ProcName;
- CurrThread.SyncInfo^.V:= V;
- CurrThread.SyncInfo^.PSScript := CurrThread.PSScript;
- CurrThread.SyncInfo^.OldThread := CurrThread;
- CurrThread.Synchronize(CurrThread.SyncInfo^.SyncMethod);
- Result := CurrThread.SyncInfo^.Res;
-{ 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;}
+destructor TMThread.Destroy;
+begin
+ SetLength(PluginsToLoad,0);
+ Client.Free;
+ inherited Destroy;
end;
+procedure TMThread.HandleError(ErrorAtLine, ErrorPosition: integer; ErrorStr: string; ErrorType: TErrorType; ErrorModule : string);
+begin
+ if OnError = nil then
+ exit;
+ ErrorData^.Line:= ErrorAtLine;
+ ErrorData^.Position:= ErrorPosition;
+ ErrorData^.Error:= ErrorStr;
+ ErrorData^.ErrType:= ErrorType;
+ ErrorData^.Module:= ErrorModule;
+ ErrorData^.IncludePath:= IncludePath;
+ CurrThread.Synchronize(OnError); //what does this do???
+end;
+
+procedure TMThread.OnThreadTerminate(Sender: TObject);
+begin
+
+end;
+
+function TMThread.ProcessDirective(DirectiveName, DirectiveArgs: string): boolean;
+var
+ plugin_idx, i: integer;
+begin
+ if DirectiveName= 'LOADDLL' then
+ begin
+ if DirectiveArgs <> '' then
+ begin;
+ plugin_idx:= PluginsGlob.LoadPlugin(DirectiveArgs);
+ if plugin_idx < 0 then
+ psWriteln(Format('Your DLL %s has not been found',[DirectiveArgs]))
+ else
+ begin;
+ for i := High(PluginsToLoad) downto 0 do
+ if PluginsToLoad[i] = plugin_idx then
+ Exit;
+ SetLength(PluginsToLoad,Length(PluginsToLoad)+1);
+ PluginsToLoad[High(PluginsToLoad)]:= plugin_idx;
+ end;
+ end;
+ end;
+ result:= True;
+end;
+
+function TMThread.LoadFile(var filename, contents: string): boolean;
+var
+ path: string;
+ f: TFileStream;
+begin
+ if FileExists(filename) then
+ path:= filename
+ else
+ path:= IncludePath + filename;
+ if not FileExists(path) then
+ begin
+ psWriteln(Path + ' doesn''t exist');
+ Result := false;
+ Exit;
+ end;
+ try
+ f:= TFileStream.Create(Path, fmOpenRead or fmShareDenyWrite);
+ except
+ Result := false;
+ exit;
+ end;
+ try
+ try
+ SetLength(contents, f.Size);
+ f.Read(contents[1], Length(contents));
+ result:= true;
+ finally
+ f.free;
+ end;
+ except
+ result:= false;
+ end;
+end;
+
+procedure TMThread.SetDebug(writelnProc: TWritelnProc);
+begin
+ DebugTo := writelnProc;
+end;
+
+procedure TMThread.SetDbgImg(DebugImageInfo: TDbgImgInfo);
+begin
+ DebugImg := DebugImageInfo;
+end;
+
+procedure TMThread.SetPaths(ScriptP, AppP,IncludeP,PluginP,FontP: string);
+begin
+ AppPath:= AppP;
+ ScriptPath:= ScriptP;
+ IncludePath:= IncludeP;
+ PluginPath:= PluginP;
+ FontPath:= FontP;
+end;
+
+{$I PSInc/Wrappers/other.inc}
+{$I PSInc/Wrappers/bitmap.inc}
+{$I PSInc/Wrappers/window.inc}
+
+{$I PSInc/Wrappers/strings.inc}
+
+{$I PSInc/Wrappers/colour.inc}
+{$I PSInc/Wrappers/math.inc}
+{$I PSInc/Wrappers/mouse.inc}
+{$I PSInc/Wrappers/file.inc}
+
+{$I PSInc/Wrappers/keyboard.inc}
+{$I PSInc/Wrappers/dtm.inc}
+{$I PSInc/Wrappers/ocr.inc}
+{$I PSInc/Wrappers/internets.inc}
+
+class function TMThread.GetExportedMethods: TExpMethodArr;
+var
+ c : integer;
+ CurrSection : string;
+
+procedure SetCurrSection(str : string);
+begin;
+ CurrSection := Str;
+end;
+
+procedure AddFunction( Ptr : Pointer; DeclStr : String);
+begin;
+ if c >= 300 then
+ raise exception.create('PSThread.LoadMethods: Exported more than 300 functions');
+ Result[c].FuncDecl:= DeclStr;
+ Result[c].FuncPtr:= Ptr;
+ Result[c].Section:= CurrSection;
+ inc(c);
+end;
+
+begin
+ c := 0;
+ CurrSection := 'Other';
+ SetLength(Result,300);
+
+ {$i PSInc/psexportedmethods.inc}
+
+ SetLength(Result,c);
+end;
+
+{***implementation TPSThread***}
{
Note to Raymond: For PascalScript, Create it on the .Create,
@@ -238,12 +397,31 @@ end;
well, it will really make the unit more straightforward to use and read.
}
+{function NewThreadCall(Procname : string) : Cardinal;
+begin;
+ result := CurrThread.PSScript.Exec.GetVar(Procname);
+end;}
-constructor TMMLPSThread.Create(CreateSuspended : boolean; TheSyncInfo : PSyncInfo; plugin_dir: string);
+{function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;
+begin;
+ CurrThread.SyncInfo^.MethodName:= ProcName;
+ CurrThread.SyncInfo^.V:= V;
+ CurrThread.SyncInfo^.PSScript := CurrThread.PSScript;
+ CurrThread.SyncInfo^.OldThread := CurrThread;
+ CurrThread.Synchronize(CurrThread.SyncInfo^.SyncMethod);
+ Result := CurrThread.SyncInfo^.Res;
+// 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;}
+
+
+constructor TPSThread.Create(CreateSuspended : boolean; TheSyncInfo : PSyncInfo; plugin_dir: string);
begin
SyncInfo:= TheSyncInfo;
- SetLength(PluginsToLoad,0);
- Client := TClient.Create(plugin_dir);
PSScript := TPSScript.Create(nil);
PSScript.UsePreProcessor:= True;
PSScript.OnNeedFile := @RequireFile;
@@ -256,99 +434,36 @@ begin
OnError:= nil;
// Set some defines
{$I PSInc/psdefines.inc}
- // Load the methods we're going to export
- Self.LoadMethods;
-
- FreeOnTerminate := True;
- Self.OnTerminate := @Self.OnThreadTerminate;
-
- inherited Create(CreateSuspended);
+ inherited Create(CreateSuspended, plugin_dir);
end;
-procedure TMMLPSThread.OnThreadTerminate(Sender: TObject);
-begin
-// Writeln('Terminating the thread');
-end;
-destructor TMMLPSThread.Destroy;
+destructor TPSThread.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/window.inc}
-
-{$I PSInc/Wrappers/strings.inc}
-
-{$I PSInc/Wrappers/colour.inc}
-{$I PSInc/Wrappers/math.inc}
-{$I PSInc/Wrappers/mouse.inc}
-{$I PSInc/Wrappers/file.inc}
-
-{$I PSInc/Wrappers/keyboard.inc}
-{$I PSInc/Wrappers/dtm.inc}
-{$I PSInc/Wrappers/ocr.inc}
-{$I PSInc/Wrappers/internets.inc}
-
-procedure TMMLPSThread.OnProcessDirective(Sender: TPSPreProcessor;
+procedure TPSThread.OnProcessDirective(Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser; const Active: Boolean;
const DirectiveName, DirectiveParam: string; var Continue: Boolean);
begin
end;
-function TMMLPSThread.PSScriptFindUnknownFile(Sender: TObject;
+function TPSThread.PSScriptFindUnknownFile(Sender: TObject;
const OrginFileName: string; var FileName, Output: string): Boolean;
begin
Writeln(OrginFileName + '-' + Output + '-' + FileName);
end;
-procedure TMMLPSThread.PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
+procedure TPSThread.PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser; const Active: Boolean;
const DirectiveName, DirectiveParam: string; var Continue: Boolean);
-var
- TempNum : integer;
- I: integer;
begin
- if DirectiveName= 'LOADDLL' then
- if DirectiveParam <> '' then
- begin;
- TempNum := PluginsGlob.LoadPlugin(DirectiveParam);
- if TempNum < 0 then
- psWriteln(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;
+ Continue:= ProcessDirective(DirectiveName, DirectiveParam);
end;
-procedure TMMLPSThread.HandleError(ErrorAtLine, ErrorPosition: integer;
- ErrorStr: string; ErrorType: TErrorType; ErrorModule : string);
-begin
- if FOnError = nil then
- exit;
- ErrorData^.Line:= ErrorAtLine;
- ErrorData^.Position:= ErrorPosition;
- ErrorData^.Error:= ErrorStr;
- ErrorData^.ErrType:= ErrorType;
- ErrorData^.Module:= ErrorModule;
- ErrorData^.IncludePath:= IncludePath;
- CurrThread.Synchronize(FOnError);
-end;
-
-
-
-procedure TMMLPSThread.OnCompile(Sender: TPSScript);
+procedure TPSThread.OnCompile(Sender: TPSScript);
var
i,ii : integer;
Fonts : TMFonts;
@@ -373,40 +488,14 @@ begin
PSScript.AddFunction(ExportedMethods[i].FuncPtr,ExportedMethods[i].FuncDecl);
end;
-function TMMLPSThread.RequireFile(Sender: TObject;
+function TPSThread.RequireFile(Sender: TObject;
const OriginFileName: String; var FileName, OutPut: string): Boolean;
-var
- path: string;
- f: TFileStream;
begin
- if FileExists(FileName) then
- Path := FileName
- else
- Path := IncludePath + Filename;
- if not FileExists(Path) then
- begin;
- psWriteln(Path + ' doesn''t exist');
- Result := false;
- Exit;
- end;
- try
- F := TFileStream.Create(Path, fmOpenRead or fmShareDenyWrite);
- except
- Result := false;
- exit;
- end;
- try
- SetLength(Output, f.Size);
- f.Read(Output[1], Length(Output));
- finally
- f.Free;
- end;
- Result := True;
+ result:= LoadFile(FileName,OutPut);
end;
procedure SIRegister_Mufasa(cl: TPSPascalCompiler);
-
-begin;
+begin
with cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap') do
begin;
RegisterMethod('constructor create');
@@ -445,7 +534,7 @@ begin;
end;
end;
-procedure TMMLPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler);
+procedure TPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler);
begin
SIRegister_Std(x);
SIRegister_Controls(x);
@@ -482,7 +571,7 @@ begin
end;
end;
-procedure TMMLPSThread.OnExecImport(Sender: TObject; se: TPSExec;
+procedure TPSThread.OnExecImport(Sender: TObject; se: TPSExec;
x: TPSRuntimeClassImporter);
begin
RIRegister_Std(x);
@@ -498,7 +587,7 @@ begin
se.RegisterFunctionName('SWAP',@swap_,nil,nil);
end;
-procedure TMMLPSThread.OutputMessages;
+procedure TPSThread.OutputMessages;
var
l: Longint;
b: Boolean;
@@ -520,7 +609,7 @@ begin
end;
end;
-procedure TMMLPSThread.Execute;
+procedure TPSThread.Execute;
begin
CurrThread := Self;
Starttime := lclintf.GetTickCount;
@@ -547,68 +636,16 @@ begin
end;
end;
-procedure TMMLPSThread.LoadMethods;
+procedure TPSThread.Terminate;
begin
- ExportedMethods:= GetExportedMethods;
+ PSScript.Stop;
end;
-class function TMMLPSThread.GetExportedMethods: TExpMethodArr;
-var
- c : integer;
- CurrSection : string;
-
- procedure SetCurrSection(str : string);
- begin;
- CurrSection := Str;
- end;
-
- procedure AddFunction( Ptr : Pointer; DeclStr : String);
- begin;
- // SetLength(ExportedMethods,c+1);
- if c >= 300 then
- raise exception.create('PSThread.LoadMethods: Exported more than 300 functions');
- Result[c].FuncDecl:= DeclStr;
- Result[c].FuncPtr:= Ptr;
- Result[c].Section:= CurrSection;
- inc(c);
- end;
-
-begin
- c := 0;
- CurrSection := 'Other';
- SetLength(Result,300);
-
- {$i PSInc/psexportedmethods.inc}
-
- SetLength(Result,c);
-
-end;
-
-procedure TMMLPSThread.SetPSScript(Script: string);
+procedure TPSThread.SetScript(script: string);
begin
PSScript.Script.Text:= Script;
end;
-procedure TMMLPSThread.SetDebug(writelnProc: TWritelnProc);
-begin
- DebugTo := writelnProc;
-end;
-
-procedure TMMLPSThread.SetDbgImg(DebugImageInfo: TDbgImgInfo);
-begin
- DebugImg := DebugImageInfo;
-end;
-
-procedure TMMLPSThread.SetPaths(ScriptP, AppP,IncludeP,PluginP,FontP: string);
-begin
- AppPath:= AppP;
- ScriptPath:= ScriptP;
- IncludePath:= IncludeP;
- PluginPath:= PluginP;
- FontPath:= FontP;
-
-end;
-
initialization
PluginsGlob := TMPlugins.Create;
@@ -617,4 +654,3 @@ finalization
//Its a nice idea, but it will segfault... the program is closing anyway.
end.
-