moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-22 07:18:51 -05:00
Code Issues Releases Wiki Activity

Added some comments to ColourPicker,

Browse Source 
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:
Raymond 2010-01-18 01:25:02 +00:00
parent b14262ebaf
commit 076f12e2c8
6 changed files with 141 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
Projects/SAMufasaGUI/framescript.pas
View File

@ -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
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
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:= ErrorAtLine;
ScriptErrorLine:= ErrorData.Line;
SynEdit.Invalidate;
SynEdit.SelStart:= ErrorPosition;
if pos('error',lowercase(errorstr)) > 0 then
formWriteln(Format('%s at line %d',[errorstr,erroratline]))
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',[errorstr,erroratline]));
formWriteln(Format('Error: %s at line %d',[ErrorData.Error,ErrorData.Line]));
end;
procedure TScriptFrame.MakeActiveScriptFrame;

40
Projects/SAMufasaGUI/testunit.pas
View File

@ -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,25 +1732,31 @@ begin;
try
Filter:= 'Mufasa Files|*.cogat;*.mufa;*.txt|Any files|*.*';
if Execute then
if FileExists(FileName) then
begin;
with CurrScript do
begin
SynEdit.Lines.LoadFromFile(FileName);
StartText := SynEdit.Lines.text;
ScriptName:= ExtractFileNameOnly(FileName);
WriteLn('Script name will be: ' + ScriptName);
ScriptFile:= FileName;
ScriptChanged := false;
RefreshTab();
Result := True;
end;
end;
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);
WriteLn('Script name will be: ' + ScriptName);
ScriptFile:= FileName;
ScriptChanged := false;
RefreshTab();
Result := True;
end;
end;
end;
function TForm1.SaveCurrentScript: boolean;
begin
with CurrScript do

5
Units/MMLAddon/PSInc/Wrappers/other.inc
View File

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

4
Units/MMLAddon/PSInc/psexportedmethods.inc
View File

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

7
Units/MMLAddon/colourpicker.pas
View File

@ -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 }

89
Units/MMLAddon/mmlpsthread.pas
View File

@ -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,7 +321,8 @@ begin
//Export all the methods
for i := 0 to high(ExportedMethods) do
PSScript.AddFunction(ExportedMethods[i].FuncPtr,ExportedMethods[i].FuncDecl);
if ExportedMethods[i].FuncPtr <> nil then
PSScript.AddFunction(ExportedMethods[i].FuncPtr,ExportedMethods[i].FuncDecl);
end;
function TMMLPSThread.RequireFile(Sender: TObject;
@ -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;