From 366764d91065ddd6445fbcc5959dd37851f5e2ca Mon Sep 17 00:00:00 2001 From: Wizzup? Date: Wed, 4 Nov 2009 22:41:06 +0000 Subject: [PATCH] Writeln() now goes to debug box on Linux too. ;-) git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@191 3f818213-9676-44b0-a9b4-5e4c4e03d09d --- Projects/SAMufasaGUI/testunit.pas | 68 +++++++++++++++++++++---- Units/MMLAddon/PSInc/Wrappers/other.inc | 2 +- Units/MMLAddon/mmlpsthread.pas | 32 +++++++----- 3 files changed, 78 insertions(+), 24 deletions(-) diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 09660ca..a8f4eba 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -95,6 +95,7 @@ type ScriptPanel: TPanel; TabPopup: TPopupMenu; TB_SaveAll: TToolButton; + DebugTimer: TTimer; TrayDivider: TMenuItem; TrayPlay: TMenuItem; TrayStop: TMenuItem; @@ -187,12 +188,15 @@ type State: TDragState; var Accept: Boolean); procedure PageControl1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ProcessDebugStream(Sender: TObject); private PopupTab : integer; SearchStart : TPoint; function GetScriptState: TScriptState; procedure SetScriptState(const State: TScriptState); public + DebugStream: String; + CurrScript : TScriptFrame; //The current scriptframe CurrTab : TMufasaTab; //The current TMufasaTab Tabs : TList; @@ -220,9 +224,9 @@ type procedure DoSearch(Next : boolean); procedure RefreshTab;//Refreshes all the form items that depend on the Script (Panels, title etc.) end; - {$ifdef mswindows} - procedure Writeln( S : String); - {$endif} + + procedure formWriteln( S : String); + const WindowTitle = 'Mufasa v2 - %s';//Title, where %s = the place of the filename. Panel_State = 0; @@ -237,14 +241,50 @@ var implementation uses - lclintf,plugins; + lclintf,plugins, + syncobjs; // for the critical sections -{$ifdef mswindows} -procedure Writeln( S : String); -begin; - Form1.Memo1.Lines.Add(s); +//{$ifdef mswindows} + +var + DebugCriticalSection: syncobjs.TCriticalSection; + +procedure TForm1.ProcessDebugStream(Sender: TObject); + +begin + if length(DebugStream) = 0 then + Exit; + + // cut off 1 newline char + + DebugCriticalSection.Enter; + + try + setlength(DebugStream, length(DebugStream) - 1); + Memo1.Lines.Add(DebugStream); + SetLength(DebugStream, 0); + finally + DebugCriticalSection.Leave; + end; end; -{$ENDIF} + +procedure formWriteln( S : String); + +begin + s := s + #10; + DebugCriticalSection.Enter; + try + Form1.DebugStream:= Form1.DebugStream + s; + finally + DebugCriticalSection.Leave; + end; + + + writeln('formWriteln: ' + s); + //Form1.Memo1.Lines.Add(s); +end; + +//{$ENDIF} procedure TForm1.RunScript; begin @@ -265,7 +305,8 @@ begin CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread; ScriptThread := TMMLPSThread.Create(True,@CurrentSyncInfo); ScriptThread.SetPSScript(CurrScript.SynEdit.Lines.Text); - ScriptThread.SetDebug(Self.Memo1); +// ScriptThread.SetDebug(Self.Memo1); + ScriptThread.SetDebug(@formWriteln); ScriptThread.OnError:=@ErrorThread; if ScriptFile <> '' then ScriptThread.SetPaths( ExtractFileDir(ScriptFile) + DS,IncludeTrailingPathDelimiter(ExpandFileName(MainDir +DS + '..' + DS + '..' + ds))) @@ -635,6 +676,10 @@ begin MainDir:= ExtractFileDir(Application.ExeName); PluginsGlob := TMPlugins.Create; PluginsGlob.PluginDirs.Add(ExpandFileName(MainDir + DS + '..' + DS + '..'+ DS + 'Plugins'+ DS)); + + { For writeln } + SetLength(DebugStream, 0); + DebugCriticalSection := syncobjs.TCriticalSection.Create; end; procedure TForm1.FormDestroy(Sender: TObject); @@ -648,6 +693,9 @@ begin Picker.Free; Window.Free; PluginsGlob.Free; + + SetLength(DebugStream, 0); + DebugCriticalSection.Free; end; procedure TForm1.FormShortCuts(var Msg: TLMKey; var Handled: Boolean); diff --git a/Units/MMLAddon/PSInc/Wrappers/other.inc b/Units/MMLAddon/PSInc/Wrappers/other.inc index 4c43aa8..1b5c5e6 100644 --- a/Units/MMLAddon/PSInc/Wrappers/other.inc +++ b/Units/MMLAddon/PSInc/Wrappers/other.inc @@ -60,7 +60,7 @@ begin; result := TForm.Create(nil); end; function CreateButton(Owner : TComponent) : TButton; -begin; +begin Result := TButton.Create(Owner); end; diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index 8ebcff4..256651b 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -40,6 +40,9 @@ type OldThread : TThread; PSScript : TPSScript; end; + + TWritelnProc = procedure(s: string); + PSyncInfo = ^TSyncInfo; TErrorType = (errRuntime,errCompile); TOnError = procedure (ErrorAtLine,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType) of object; @@ -53,7 +56,8 @@ type private ScriptPath, AppPath : string; protected - DebugTo : TMemo; + //DebugTo : TMemo; + DebugTo: TWritelnProc; PluginsToload : Array of integer; FOnError : TOnError; procedure OnCompile(Sender: TPSScript); @@ -70,7 +74,7 @@ type SyncInfo : PSyncInfo; //We need this for callthreadsafe property OnError : TOnError read FOnError write FOnError; procedure SetPSScript(Script : string); - procedure SetDebug( Strings : TMemo ); + procedure SetDebug( writelnProc : TWritelnProc ); procedure SetPaths(ScriptP,AppP : string); constructor Create(CreateSuspended: Boolean; TheSyncInfo : PSyncInfo); destructor Destroy; override; @@ -95,19 +99,21 @@ uses {Some General PS Functions here} procedure psWriteln(str : string); -{$IFDEF WINDOWS} +//{$IFDEF WINDOWS} begin - if CurrThread.DebugTo <> nil then - begin; + if Assigned(CurrThread.DebugTo) then + CurrThread.DebugTo(str); + {if CurrThread.DebugTo <> nil then + begin; CurrThread.DebugTo.lines.add(str); CurrThread.DebugTo.Refresh; - end; + end; } end; -{$ELSE} -begin -writeln(str); -end; -{$ENDIF} +//{$ELSE} +//begin +//writeln(str); +//end; +//{$ENDIF} function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant; begin; @@ -340,9 +346,9 @@ begin PSScript.Script.Text:= Script; end; -procedure TMMLPSThread.SetDebug(Strings: TMemo); +procedure TMMLPSThread.SetDebug(writelnProc: TWritelnProc); begin - DebugTo := Strings; + DebugTo := writelnProc; end; procedure TMMLPSThread.SetPaths(ScriptP, AppP: string);