Added some comments to ColourPicker,

Edited the way Errors are shown (thread-safe now),
When error occurs in an include Simba will open the tab(if not yet open) and go to the error,
Added Writeln that accepts chars,strings and all kind of integers.. (not sure whether to keep it)
Added format!

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@423 3f818213-9676-44b0-a9b4-5e4c4e03d09d

Projects/SAMufasaGUI/framescript.pas

@@ -39,6 +39,7 @@ type
     ss_Paused: Means the script is currently in pause modus.
     ss_Stopping: Means we've asked PS-Script politely to stop the script (next time we press the stop button we won't be that nice).
   }
+
   { TScriptFrame }
 
   TScriptFrame = class(TFrame)
@@ -61,6 +62,7 @@ type
     OwnerPage  : TPageControl;
     OwnerSheet : TTabSheet;//The owner TTabsheet -> For title setting
   public
+    ErrorData : TErrorData;  //For threadsafestuff
     ScriptErrorLine : integer; //Highlight the error line!
     ScriptFile : string;//The path to the saved/opened file currently in the SynEdit
     StartText : string;//The text synedit holds upon start/open/save
@@ -71,7 +73,7 @@ type
     FScriptState : TScriptState;//Stores the ScriptState, if you want the Run/Pause/Start buttons to change accordingly, acces through Form1
     procedure undo;
     procedure redo;
-    procedure ErrorThread(ErrorAtLine,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType);
+    procedure HandleErrorData;
     procedure MakeActiveScriptFrame;
     procedure ScriptThreadTerminate(Sender: TObject);
     constructor Create(TheOwner: TComponent); override;
@@ -237,17 +239,43 @@ begin
     end;
 end;
 
-procedure TScriptFrame.ErrorThread(ErrorAtLine, ErrorPosition: integer;
+procedure TScriptFrame.HandleErrorData;
-  ErrorStr: string; ErrorType: TErrorType);
+var
+  i : integer;
 begin
-  MakeActiveScriptFrame;
+  if ErrorData.Module <> '' then
-  ScriptErrorLine:= ErrorAtLine;
+  begin;
-  SynEdit.Invalidate;
+    if not FileExists(ErrorData.Module) then
-  SynEdit.SelStart:= ErrorPosition;
+      ErrorData.Module := ErrorData.IncludePath + ErrorData.Module;
-  if pos('error',lowercase(errorstr)) > 0 then
+    if not FileExists(ErrorData.Module) then
-    formWriteln(Format('%s at line %d',[errorstr,erroratline]))
+      Writeln('ERROR comes from a non-existing file....')
     else
-    formWriteln(Format('Error: %s at line %d',[errorstr,erroratline]));
+    begin
+      ErrorData.Module:= SetDirSeparators(ErrorData.Module);// Set it right ;-)
+      for i := 0 to Form1.Tabs.Count - 1 do
+        if lowercase(TMufasaTab(Form1.Tabs[i]).ScriptFrame.ScriptFile) = lowercase(ErrorData.Module) then
+        begin;
+          ErrorData.Module:= '';
+          TMufasaTab(Form1.Tabs[i]).ScriptFrame.ErrorData := Self.ErrorData;
+          TMufasaTab(Form1.Tabs[i]).ScriptFrame.HandleErrorData;
+          Exit;
+        end;
+      Form1.AddTab;
+      Form1.LoadScriptFile(ErrorData.Module);
+      ErrorData.Module:= '';
+      Form1.CurrScript.ErrorData := Self.ErrorData;
+      Form1.CurrScript.HandleErrorData;
+      exit;
+    end;
+  end;
+  MakeActiveScriptFrame;
+  ScriptErrorLine:= ErrorData.Line;
+  SynEdit.Invalidate;
+  SynEdit.SelStart:= ErrorData.Position;
+  if pos('error',lowercase(ErrorData.Error)) > 0 then
+    formWriteln(Format('%s at line %d',[ErrorData.Error,ErrorData.Line]))
+  else
+    formWriteln(Format('Error: %s at line %d',[ErrorData.Error,ErrorData.Line]));
 end;
 
 procedure TScriptFrame.MakeActiveScriptFrame;

Projects/SAMufasaGUI/testunit.pas

@@ -43,7 +43,7 @@ uses
   ocr, updateform, simbasettings;
 
 const
-    SimbaVersion = 413;
+    SimbaVersion = 423;
 
 type
 
@@ -314,6 +314,7 @@ type
     property ScriptState : TScriptState read GetScriptState write SetScriptState;
     procedure SafeCallThread;
     function OpenScript : boolean;
+    function LoadScriptFile(filename : string) : boolean;
     function SaveCurrentScript : boolean;
     function SaveCurrentScriptAs : boolean;
     function CanExitOrOpen : boolean;
@@ -540,7 +541,8 @@ begin
     DbgImgInfo.GetDebugBitmap:= @DebugImgForm.GetDbgBmp;
     DbgImgInfo.GetBitmap:= @DebugImgForm.GetDebugImage;
     ScriptThread.SetDbgImg(DbgImgInfo);
-    ScriptThread.OnError:=@ErrorThread;
+    ScriptThread.ErrorData:= @ErrorData;
+    ScriptThread.OnError:= @HandleErrorData;
 
     if ScriptFile <> '' then
       ScriptPath := ExtractFileDir(ScriptFile);
@@ -1730,13 +1732,22 @@ begin;
   try
     Filter:= 'Mufasa Files|*.cogat;*.mufa;*.txt|Any files|*.*';
     if Execute then
+      result := LoadScriptFile(filename);
+  finally
+    Free;
+  end;
+end;
+
+function TForm1.LoadScriptFile(FileName : string): boolean;
+begin
   if FileExists(FileName) then
   begin;
     with CurrScript do
     begin
+      filename := SetDirSeparators(filename);
       SynEdit.Lines.LoadFromFile(FileName);
       StartText := SynEdit.Lines.text;
-          ScriptName:= ExtractFileNameOnly(FileName);
+      ScriptName:= ExtractFileNameOnly(filename);
       WriteLn('Script name will be: ' + ScriptName);
       ScriptFile:= FileName;
       ScriptChanged := false;
@@ -1744,9 +1755,6 @@ begin;
       Result := True;
     end;
   end;
-  finally
-    Free;
-  end;
 end;
 
 function TForm1.SaveCurrentScript: boolean;

Units/MMLAddon/PSInc/Wrappers/other.inc

@@ -84,6 +84,11 @@ begin;
       cap := true;
 end;
 
+function psFormat(const fmt : string;const args : array of const) : string;
+begin;
+  Result := Format(fmt,Args);
+end;
+
 function Distance(x1, y1, x2, y2: Integer): Integer;
 begin;
   Result := Round(Sqrt(Sqr(x2-x1) + Sqr(y2-y1)));

Units/MMLAddon/PSInc/psexportedmethods.inc

@@ -22,7 +22,7 @@
 }
 
 AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
-AddFunction(@psWriteln,'procedure writeln(s : string);');
+AddFunction(nil,'procedure writeln(s : string);'); //We use special function for this
 
 { DTM }
 SetCurrSection('DTM');
@@ -91,11 +91,13 @@ 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');
 
 
 
 {string}
 AddFunction(@Capitalize,'function Capitalize(str : string) : string;');
+AddFunction(@psFormat,'function Format(const fmt : string;const args : array of const) : string;');
 
 {web}
 SetCurrSection('Web');

Units/MMLAddon/colourpicker.pas

@@ -111,12 +111,14 @@ begin
   { Disable both of the color pick buttons }
   w := 0;
   h := 0;
+  { If the target window isn't valid (closed etc), make the destkop the new window}
   if not Self.Window.TargetValid then
     self.Window.SetDesktop;
+  Input := TMInput.Create(Self.Window);//For the correct x,y values
 
+  {Desktop is needed for the whole picture}
   Desktop := TMWindow.Create;
   Desktop.SetDesktop;
-  Input := TMInput.Create(Self.Window);
   Desktop.GetDimensions(w, h);
 
   Application.MainForm.Enabled := False;
@@ -126,9 +128,6 @@ begin
   ScreenForm := TForm.Create(Application.MainForm);
   InfoForm := TForm.Create(ScreenForm);
 
-
-
-
   { Initialize the form that will hold the client image }
   ScreenForm.Caption := 'SimbaColourPicker';
   { Set the form's dimensions to match that of the screen }

Units/MMLAddon/mmlpsthread.pas

@@ -23,6 +23,7 @@
 
 unit mmlpsthread;
 
+{$Define PS_USESSUPPORT}
 {$mode objfpc}{$H+}
 
 interface
@@ -52,7 +53,15 @@ type
     end;
     PSyncInfo = ^TSyncInfo;
     TErrorType = (errRuntime,errCompile);
-    TOnError = procedure (ErrorAtLine,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType) of object;
+    TOnError = procedure of object;
+    TErrorData = record
+      Line,Position : integer;
+      Error : string;
+      ErrType : TErrorType;
+      Module : string;
+      IncludePath : string;
+    end;
+    PErrorData = ^TErrorData;
     TExpMethod = record
       Section : string;
       FuncDecl : string;
@@ -64,11 +73,15 @@ type
       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;
       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;
@@ -89,6 +102,7 @@ type
       Client : TClient;
       StartTime : LongWord;
       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;
@@ -107,7 +121,7 @@ uses
   {$ifdef mswindows}windows,{$endif}
   uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms,
   uPSC_extctrls, //Compile-libs
-
+  uPSUtils,
   uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,
   uPSR_extctrls, //Runtime-libs
   Graphics, //For Graphics types
@@ -122,23 +136,31 @@ uses
 
 {Some General PS Functions here}
 procedure psWriteln(str : string);
-//{$IFDEF WINDOWS}
 begin
   if Assigned(CurrThread.DebugTo) then
     CurrThread.DebugTo(str)
   else
     writeln(str);
- {if CurrThread.DebugTo <> nil then
- begin;
-    CurrThread.DebugTo.lines.add(str);
-    CurrThread.DebugTo.Refresh;
- end; }
 end;
-//{$ELSE}
+
-//begin
+function writeln_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
-//writeln(str);
+var
-//end;
+  arr: TPSVariantIFC;
-//{$ENDIF}
+begin
+  Result:=true;
+  arr:=NewTPSVariantIFC(Stack[Stack.Count-1],false);
+  case arr.aType.BaseType of
+    btString,btChar : psWriteln(stack.GetString(-1));
+    btU8, btS8, btU16, btS16, btU32, btS32: psWriteln(inttostr(stack.GetInt(-1)));
+    {$IFNDEF PS_NOINT64}btS64 : psWriteln(IntToStr(stack.GetInt64(-1))); {$ENDIF}
+    else Result:=false;
+  end;
+end;
+
+function NewThreadCall(Procname : string) : Cardinal;
+begin;
+  result :=   CurrThread.PSScript.Exec.GetVar(Procname);
+end;
 
 function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;
 begin;
@@ -188,6 +210,7 @@ begin
   PSScript.OnCompile:= @OnCompile;
   PSScript.OnCompImport:= @OnCompImport;
   PSScript.OnExecImport:= @OnExecImport;
+  PSScript.OnFindUnknownFile:=@PSScriptFindUnknownFile;
   OnError:= nil;
   // Set some defines
   {$I PSInc/psdefines.inc}
@@ -234,6 +257,12 @@ procedure TMMLPSThread.OnProcessDirective(Sender: TPSPreProcessor;
 begin
 end;
 
+function TMMLPSThread.PSScriptFindUnknownFile(Sender: TObject;
+  const OrginFileName: string; var FileName, Output: string): Boolean;
+begin
+  Writeln(OrginFileName + '-' +  Output + '-' + FileName);
+end;
+
 procedure TMMLPSThread.PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
   Parser: TPSPascalPreProcessorParser; const Active: Boolean;
   const DirectiveName, DirectiveParam: string; var Continue: Boolean);
@@ -259,6 +288,20 @@ begin
   Continue:= True;
 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);
@@ -278,6 +321,7 @@ begin
 
   //Export all the methods
   for i := 0 to high(ExportedMethods) do
+    if ExportedMethods[i].FuncPtr <> nil then
       PSScript.AddFunction(ExportedMethods[i].FuncPtr,ExportedMethods[i].FuncDecl);
 end;
 
@@ -362,6 +406,12 @@ begin
   SIRegister_Forms(x);
   SIRegister_ExtCtrls(x);
   SIRegister_Mufasa(x);
+  with x.AddFunction('procedure writeln;').decl do
+    with AddParam do
+    begin
+      OrgName:= 'x';
+      Mode:= pmIn;
+    end;
 end;
 
 procedure TMMLPSThread.OnExecImport(Sender: TObject; se: TPSExec;
@@ -375,6 +425,7 @@ begin
   RIRegister_Forms(x);
   RIRegister_ExtCtrls(x);
   RIRegister_Mufasa(x);
+  se.RegisterFunctionName('WRITELN',@Writeln_,nil,nil);
 end;
 
 procedure TMMLPSThread.OutputMessages;
@@ -390,7 +441,7 @@ begin
       b := True;
       if OnError <> nil then
         with PSScript.CompilerMessages[l] do
-          OnError(Row, Pos, MessageToString,errCompile)
+          HandleError(Row, Pos, MessageToString,errCompile, ModuleName)
       else
         psWriteln(PSScript.CompilerErrorToStr(l) + ' at line ' + inttostr(PSScript.CompilerMessages[l].Row));
     end else
@@ -411,10 +462,10 @@ begin
       psWriteln('Compiled succesfully in ' + IntToStr(GetTickCount - Starttime) + ' ms.');
 //      if not (ScriptState = SCompiling) then
         if not PSScript.Execute then
-        begin
+          HandleError(PSScript.ExecErrorRow,PSScript.ExecErrorPosition,PSScript.ExecErrorToString,
-          if OnError <> nil then
+                      errRuntime, PSScript.ExecErrorFileName)
-            OnError(PSScript.ExecErrorRow,PSScript.ExecErrorPosition,PSScript.ExecErrorToString,errRuntime);
+        else
-        end else psWriteln('Succesfully executed');
+          psWriteln('Succesfully executed');
     end else
     begin
       OutputMessages;