Added compile-only action;

Added GetTextAt to the wrappers, made implemenetation for IsKeyHeld on windows and added a link to the handbook.

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

trunk/Projects/SAMufasaGUI/testunit.lfm

@@ -1136,6 +1136,11 @@ object Form1: TForm1
         ImageIndex = 6
         OnClick = ActionRunExecute
       end
+      object MenuItemCompile: TMenuItem
+        Action = ActionCompileScript
+        Caption = 'Compile'
+        OnClick = ActionCompileScriptExecute
+      end
       object MenuItemPause: TMenuItem
         Action = ActionPauseScript
         Bitmap.Data = {
@@ -1407,6 +1412,10 @@ object Form1: TForm1
         }
         OnClick = MenuItemAboutClick
       end
+      object MenuItemHandbook: TMenuItem
+        Caption = '&Handbook'
+        OnClick = MenuItemHandbookClick
+      end
       object MenuItemReportBug: TMenuItem
         Caption = '&Report a Bug'
         Bitmap.Data = {
@@ -2784,6 +2793,11 @@ object Form1: TForm1
       ImageIndex = 25
       OnExecute = ActionExitExecute
     end
+    object ActionCompileScript: TAction
+      Caption = 'ActionCompileScript'
+      OnExecute = ActionCompileScriptExecute
+      ShortCut = 16504
+    end
   end
   object DebugTimer: TTimer
     OnTimer = ProcessDebugStream

trunk/Projects/SAMufasaGUI/testunit.pas

@@ -43,7 +43,7 @@ uses
   ColorBox              , about, framefunctionlist, ocr, updateform, simbasettings;
 
 const
-    SimbaVersion = 469;
+    SimbaVersion = 501;
 
 type
 
@@ -64,6 +64,7 @@ type
   { TForm1 }
 
   TForm1 = class(TForm)
+    ActionCompileScript: TAction;
     ActionExit: TAction;
     ActionReplace: TAction;
     ActionFindNext: TAction;
@@ -98,6 +99,8 @@ type
     MenuEdit: TMenuItem;
     MenuHelp: TMenuItem;
     MenuExtra: TMenuItem;
+    MenuItemCompile: TMenuItem;
+    MenuItemHandbook: TMenuItem;
     MenuItemAbout: TMenuItem;
     MenuItemReportBug: TMenuItem;
     MenuViewSettings: TMenuItem;
@@ -204,6 +207,7 @@ type
     MTrayIcon: TTrayIcon;
     procedure ActionClearDebugExecute(Sender: TObject);
     procedure ActionCloseTabExecute(Sender: TObject);
+    procedure ActionCompileScriptExecute(Sender: TObject);
     procedure ActionCopyExecute(Sender: TObject);
     procedure ActionCutExecute(Sender: TObject);
     procedure ActionDeleteExecute(Sender: TObject);
@@ -235,6 +239,7 @@ type
     procedure FunctionListChange(Sender: TObject; Node: TTreeNode);
     procedure FunctionListEnter(Sender: TObject);
     procedure FunctionListExit(Sender: TObject);
+    procedure MenuItemHandbookClick(Sender: TObject);
     procedure MenuItemColourHistoryClick(Sender: TObject);
     procedure dlgReplaceFind(Sender: TObject);
     procedure dlgReplaceReplace(Sender: TObject);
@@ -534,7 +539,7 @@ begin
     PluginsPath := LoadSettingDef('Settings/Plugins/Path', ExpandFileName(MainDir + DS + '..' + DS + '..'+ DS + 'Plugins'+ DS));
     ScriptErrorLine:= -1;
     CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread;
-    UseCPascal := LoadSettingDef('Settings/Interpreter/UseCPascal', 'True');
+    UseCPascal := LoadSettingDef('Settings/Interpreter/UseCPascal', 'False');
     try
       if lowercase(UseCPascal) = 'true' then
         ScriptThread := TCPThread.Create(True,@CurrentSyncInfo,PluginsPath)
@@ -906,6 +911,35 @@ begin
     Self.ClearScript;  //DeleteTab would take care of this already, but yeah, it's neater this way.
 end;
 
+procedure TForm1.ActionCompileScriptExecute(Sender: TObject);
+var
+  UseCPascal : string;
+  PluginsPath : string;
+  TempThread : TMThread;
+begin
+  UseCPascal := LoadSettingDef('Settings/Interpreter/UseCPascal', 'False');
+  PluginsPath := LoadSettingDef('Settings/Plugins/Path', ExpandFileName(MainDir + DS + '..' + DS + '..'+ DS + 'Plugins'+ DS));
+  try
+    if lowercase(UseCPascal) = 'true' then
+      TempThread := TCPThread.Create(True,nil,PluginsPath)
+    else
+      TempThread := TPSThread.Create(True,nil,PluginsPath);
+  except
+    writeln('Failed to initialise the library!');
+    Exit;
+  end;
+  {$IFNDEF TERMINALWRITELN}
+  TempThread.SetDebug(@formWriteln);
+  TempThread.DebugMemo := Self.Memo1;
+  {$ENDIF}
+  TempThread.SetScript(CurrScript.SynEdit.Text);
+  TempThread.ErrorData:= @CurrScript.ErrorData;
+  TempThread.OnError:= @CurrScript.HandleErrorData;
+  TempThread.CompileOnly:= true;
+  TempThread.Resume;
+
+end;
+
 procedure TForm1.ActionCopyExecute(Sender: TObject);
 begin
   if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then
@@ -1192,6 +1226,11 @@ begin
 //  StatusBar.Panels[2].Text:= '';
 end;
 
+procedure TForm1.MenuItemHandbookClick(Sender: TObject);
+begin
+  OpenURL('http://vila.villavu.com/mufasa/mufasa_ps_handbook/');
+end;
+
 procedure TForm1.MenuItemColourHistoryClick(Sender: TObject);
 begin
   MenuItemColourHistory.Checked := not ColourHistoryForm.Visible;

trunk/Units/MMLAddon/PSInc/Wrappers/ocr.inc

@@ -26,3 +26,9 @@ function TPAFromText(text, font: String;out w,h : integer): TPointArray; extdecl
 begin
   Result := CurrThread.Client.MOCR.TextToFontTPA(text, font, w, h);
 end;
+
+function GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing,
+                   color, tol, len: integer; font: string): string; extdecl;
+begin
+  result := CurrThread.Client.MOCR.GetTextAt(atx,aty,minvspacing,maxvspacing,hspacing,color,tol,len,font);
+end;

trunk/Units/MMLAddon/PSInc/psexportedmethods.inc

@@ -211,6 +211,7 @@ AddFunction(@rs_GetUpTextAt, 'function rs_GetUpTextAt(x, y : integer): string;')
 AddFunction(@BitmapFromText, 'function BitmapFromText(text, font: String): integer;');
 AddFunction(@TPAFromText, 'function TPAFromText(text, font: String;out w,h : integer): TPointArray;');
 AddFunction(@MaskFromText, 'function MaskFromText(text, font: String): TMask;');
+AddFunction(@GetTextAt,'function GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing,color, tol, len: integer; font: string): string;');
 
 {Bitmaps}
 SetCurrSection('Bitmaps');

trunk/Units/MMLAddon/mmlpsthread.pas

@@ -89,6 +89,7 @@ type
       ErrorData : PErrorData; //We need this for thread-safety etc
       OnError  : TOnError; //Error handeler
 
+      CompileOnly : boolean;
       procedure HandleError(ErrorAtLine,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType; ErrorModule : string);
       function ProcessDirective(DirectiveName, DirectiveArgs: string): boolean;
       function LoadFile(var filename, contents: string): boolean;
@@ -263,6 +264,7 @@ begin
   ExportedMethods:= GetExportedMethods;
   SetLength(PluginsToLoad,0);
   FreeOnTerminate := True;
+  CompileOnly := false;
   OnTerminate := @OnThreadTerminate;
   OnError:= nil;
   inherited Create(CreateSuspended);
@@ -397,6 +399,7 @@ end;
 {$I PSInc/Wrappers/keyboard.inc}
 {$I PSInc/Wrappers/dtm.inc}
 {$I PSInc/Wrappers/ocr.inc}
+
 {$I PSInc/Wrappers/internets.inc}
 
 class function TMThread.GetExportedMethods: TExpMethodArr;
@@ -647,6 +650,8 @@ begin
     begin
       OutputMessages;
       psWriteln('Compiled succesfully in ' + IntToStr(GetTickCount - Starttime) + ' ms.');
+      if CompileOnly then
+        exit;
 //      if not (ScriptState = SCompiling) then
         if not PSScript.Execute then
           HandleError(PSScript.ExecErrorRow,PSScript.ExecErrorPosition,PSScript.ExecErrorToString,
@@ -748,6 +753,8 @@ begin
         with ExportedMethods[i] do
           interp_meth(self.instance,FuncPtr,PChar(FuncDecl));
     psWriteln('Compiled Successfully in ' +  IntToStr(GetTickCount - Starttime) + 'ms');
+    if CompileOnly then
+      exit;
     if interp_run(instance) then
        psWriteln('Executed Successfully')
     else

trunk/Units/MMLCore/os_windows.pas

@@ -318,7 +318,7 @@ implementation
   end;
   function TWindow.IsKeyHeld(key: integer): boolean;
   begin
-    raise Exception.CreateFmt('IsKeyHeld isn''t implemented yet on Windows', []);
+    Result := (GetAsyncKeyState(key)  <> 0);
   end;
 
   function TWindow.GetKeyCode(c: char): integer;