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

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
This commit is contained in:
Wizzup? 2009-11-04 22:41:06 +00:00
parent eeb04eecfb
commit 366764d910
3 changed files with 78 additions and 24 deletions

View File

@ -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;
{$ENDIF}
end;
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);

View File

@ -60,7 +60,7 @@ begin;
result := TForm.Create(nil);
end;
function CreateButton(Owner : TComponent) : TButton;
begin;
begin
Result := TButton.Create(Owner);
end;

View File

@ -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
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);