mirror of
https://github.com/moparisthebest/Simba
synced 2024-12-22 15:28:50 -05:00
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
This commit is contained in:
parent
b14262ebaf
commit
076f12e2c8
@ -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;
|
||||
ErrorStr: string; ErrorType: TErrorType);
|
||||
procedure TScriptFrame.HandleErrorData;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
MakeActiveScriptFrame;
|
||||
ScriptErrorLine:= ErrorAtLine;
|
||||
SynEdit.Invalidate;
|
||||
SynEdit.SelStart:= ErrorPosition;
|
||||
if pos('error',lowercase(errorstr)) > 0 then
|
||||
formWriteln(Format('%s at line %d',[errorstr,erroratline]))
|
||||
if ErrorData.Module <> '' then
|
||||
begin;
|
||||
if not FileExists(ErrorData.Module) then
|
||||
ErrorData.Module := ErrorData.IncludePath + ErrorData.Module;
|
||||
if not FileExists(ErrorData.Module) then
|
||||
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;
|
||||
|
@ -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;
|
||||
|
@ -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)));
|
||||
|
@ -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');
|
||||
|
@ -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 }
|
||||
|
@ -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
|
||||
//writeln(str);
|
||||
//end;
|
||||
//{$ENDIF}
|
||||
|
||||
function writeln_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||
var
|
||||
arr: TPSVariantIFC;
|
||||
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
|
||||
if OnError <> nil then
|
||||
OnError(PSScript.ExecErrorRow,PSScript.ExecErrorPosition,PSScript.ExecErrorToString,errRuntime);
|
||||
end else psWriteln('Succesfully executed');
|
||||
HandleError(PSScript.ExecErrorRow,PSScript.ExecErrorPosition,PSScript.ExecErrorToString,
|
||||
errRuntime, PSScript.ExecErrorFileName)
|
||||
else
|
||||
psWriteln('Succesfully executed');
|
||||
end else
|
||||
begin
|
||||
OutputMessages;
|
||||
|
Loading…
Reference in New Issue
Block a user