Made some changes; Fixed some bitmap issues; Added some functions to extensions; fixed bug in PS

Extensions/test.sex

@@ -19,6 +19,7 @@ begin;
       '0'..'9': result := result + str[i];
     end;
 end;
+  
 procedure Attach;
 var
   Fonts : string;
@@ -26,6 +27,11 @@ var
   newvers :integer;
   Vers : integer;
 begin;
+  case MessageDlg('Test me!', 'Do you want to test me?',mtConfirmation, [mbNo,mbYes,mbCancel],0) of
+    mrYes : Writeln('hell yeah!');
+    mrNo  : Writeln('Hell no!');
+    mrCancel : Writeln('CANCEL THIS SHIT!');
+  end;	
   Vers := StrToIntDef(Settings.GetKeyValueDef('FontVersion','-1'),-1);
   newvers := strtointdef(GetNumbers(getpage('http://simba.villavu.com/bin/Fonts/Version')),-1);
   if newVers > vers then

Projects/SAMufasaGUI/about.pas

@@ -61,9 +61,6 @@ procedure TAboutForm.FormCreate(Sender: TObject);
 begin
   Self.Caption := format('About Simba r%d', [TestUnit.SimbaVersion]);
   Self.LabelRevision.Caption := format('Revision %d', [TestUnit.SimbaVersion]);
-  AboutMemo.Lines.Add('---Simba---');
-  AboutMemo.Lines.Add('');
-  AboutMemo.Lines.Add('');
   AboutMemo.Lines.Add('Simba is released under the GPL license.');
   AboutMemo.Lines.Add(format('You are currently using version: %d',[Testunit.SimbaVersion]));
   AboutMemo.Lines.Add('');

Projects/SAMufasaGUI/framefunctionlist.pas

@@ -452,6 +452,8 @@ var
   i : integer;
   tmpNode : TTreeNode;
 begin;
+  if procs = nil then
+    exit;
   for i := 0 to Procs.Count - 1 do
     if (Procs[i] is TciProcedureDeclaration) then
       with Procs[i] as TciProcedureDeclaration do

Projects/SAMufasaGUI/psextension.pas

@@ -49,7 +49,7 @@ uses
   uPSC_extctrls,uPSC_menus, //Compile libs
   uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,
   uPSR_extctrls,uPSR_menus, //Runtime-libs
-  testunit,updateform,settingssandbox,bitmaps,mmisc//Writeln
+  testunit,updateform,settingssandbox,bitmaps,files,Dialogs, mmisc//Writeln
   ;
 
 function TSimbaPSExtension.HookExists(const HookName: String): Boolean;
@@ -123,12 +123,21 @@ begin
   Sender.Comp.AddConstantN('PluginPath','string').SetString(Form1.PluginPath);
   Sender.Comp.AddConstantN('FontPath','string').SetString(form1.FontPath);
   Sender.Comp.AddConstantN('ExtPath','string').SetString(form1.ExtPath);
+  Sender.Comp.AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmati'
+                                      +'on, mtCustom )');
+  Sender.Comp.AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, m'
+                                     +'bIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )');
+  Sender.Comp.AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn');
   Sender.AddFunction(@formWritelnEx,'procedure Writeln(s : string)');
   Sender.AddFunction(@ext_GetPage,'function GetPage(const url : string) : string');
   Sender.AddFunction(@ext_DecompressBZip2,'function DecompressBZip2(const input: string;out output : string; const BlockSize: Cardinal): boolean;');
   Sender.AddFunction(@ext_UnTar,'function UnTar(const Input : string; out Content : TStringArray) : boolean;');
   Sender.AddFunction(@ext_UnTarEx,'function UnTarEx(const Input : string;const outputdir : string; overwrite : boolean): boolean;');
-
+  Sender.AddFunction(@DirectoryExists,'Function DirectoryExists (Const Directory : String) : Boolean;');
+  Sender.AddFunction(@FileExists,'Function FileExists (Const FileName : String) : Boolean;');
+  Sender.AddFunction(@GetFiles, 'function GetFiles(Path, Ext: string): TStringArray;');
+  Sender.AddFunction(@GetDirectories,'function GetDirectories(Path: string): TstringArray;');
+  Sender.AddFunction(@ext_MessageDlg,'function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;');
   Sender.AddRegisteredPTRVariable('Settings','TMMLSettingsSandbox');
   Sender.AddRegisteredVariable('Simba','TForm');
   Sender.AddRegisteredVariable('Simba_MainMenu','TMainMenu');

Projects/SAMufasaGUI/testunit.pas

@@ -1866,7 +1866,7 @@ end;
 
 procedure TForm1.MenuItemHandbookClick(Sender: TObject);
 begin
-  OpenURL('http://vila.villavu.com/mufasa/mufasa_ps_handbook/');
+  OpenURL('http://wizzup.org/simba/doc/ps_handbook/');
 end;
 
 procedure TForm1.MenuItemColourHistoryClick(Sender: TObject);
@@ -2713,9 +2713,11 @@ end;
 procedure TForm1.SafeCallThread;
 var
   thread: TMThread;
+  LocalCopy : TSyncInfo;
 begin
-  mDebugLn('Executing : ' + CurrentSyncInfo.MethodName);
-  thread:= TMThread(CurrentSyncInfo.OldThread);
+  LocalCopy := CurrentSyncInfo;
+  mDebugLn('Executing : ' + LocalCopy.MethodName);
+  thread:= TMThread(LocalCopy.OldThread);
   mmlpsthread.CurrThread:= thread;
   try
     if thread is TPSThread then
@@ -2723,7 +2725,7 @@ begin
       with TPSThread(thread).PSScript do
       begin
         OnLine:=@OnLinePSScript;
-        CurrentSyncInfo.Res:= Exec.RunProcPVar(CurrentSyncInfo.V^,Exec.GetProc(CurrentSyncInfo.MethodName));
+        LocalCopy.Res^:= Exec.RunProcPVar(LocalCopy.V^,Exec.GetProc(LocalCopy.MethodName));
         Online := nil;
       end;
     end else

Units/MMLAddon/PSInc/Wrappers/extensions.inc

@@ -92,3 +92,8 @@ begin
       mDebugLn('Exception in GetPage in Extensions: ' + e.message);
   end;
 end;
+
+function ext_MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
+begin
+  result := MessageDlg(acaption,amsg,dlgtype,buttons,helpctx);
+end;

Units/MMLAddon/PSInc/Wrappers/other.inc

@@ -76,6 +76,11 @@ begin
     CurrThread.DebugClear();
 end;
 
+procedure ps_SetSupressExceptions(Supress : boolean);extdecl;
+begin
+  CurrThread.Client.MFinder.WarnOnly:= Supress;
+end;
+
 procedure ps_SaveScreenshot(FileName: string); extdecl;
 var
   w,h : integer;

Units/MMLAddon/PSInc/psexportedmethods.inc

@@ -24,6 +24,7 @@
 AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
 AddFunction(@pswriteln,'procedure Writeln(x: string);'); //PS defines a special, keep this for CPascal
 
+
 { DTM }
 SetCurrSection('DTM');
 AddFunction(@ps_SetDTMName, 'procedure SetDTMName(DTM : integer;const name : string);');
@@ -109,6 +110,7 @@ AddFunction(@ps_DeleteINI,'procedure DeleteINI(const Section, KeyName, FileName:
 
 {other}
 SetCurrSection('Other');
+AddFunction(@ps_SetSupressExceptions, 'procedure SetSupressExceptions(Supress : boolean);');
 AddFunction(@ps_SaveScreenshot,'procedure SaveScreenshot(FileName: string);');
 AddFunction(@ps_Wait, 'procedure wait(t: integer);');
 AddFunction(@ps_Wait, 'procedure Sleep(t: integer);');

Units/MMLAddon/mmlpsthread.pas

@@ -41,7 +41,7 @@ type
     TSyncInfo = record
       V : MufasaTypes.PVariantArray;
       MethodName : string;
-      Res : Variant;
+      Res : ^Variant;
       SyncMethod : procedure of object;
       OldThread : TThread;
     end;
@@ -465,11 +465,18 @@ end;
 
 function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant; extdecl;
 begin
-  CurrThread.SyncInfo^.MethodName:= ProcName;
-  CurrThread.SyncInfo^.V:= @V;
-  CurrThread.SyncInfo^.OldThread := CurrThread;
-  CurrThread.Synchronize(CurrThread.SyncInfo^.SyncMethod);
-  Result := CurrThread.SyncInfo^.Res;
+  if GetCurrentThreadId = MainThreadID then
+  begin
+    with TPSThread(currthread).PSScript do
+      Result := Exec.RunProcPVar(V,Exec.GetProc(Procname));
+  end else
+  begin
+    CurrThread.SyncInfo^.MethodName:= ProcName;
+    CurrThread.SyncInfo^.V:= @V;
+    CurrThread.SyncInfo^.OldThread := CurrThread;
+    CurrThread.SyncInfo^.Res := @Result;
+    CurrThread.Synchronize(CurrThread.SyncInfo^.SyncMethod);
+  end;
 end;
 
 {$I PSInc/Wrappers/other.inc}

Units/MMLCore/bitmaps.pas

@@ -35,8 +35,8 @@ type
   TMufasaBitmap = class(TObject)
   private
     w,h : integer;
-    TransparentColor : TRGB32;
-    TransparentSet : boolean;
+    FTransparentColor : TRGB32;
+    FTransparentSet : boolean;
     FIndex : integer;
     FName : string;
   public
@@ -61,9 +61,6 @@ type
     function CreateTPA(SearchCol : TColor) : TPointArray;
     function FastGetPixel(x,y : integer) : TColor;
     function FastGetPixels(TPA : TPointArray) : TIntegerArray;
-    Procedure SetTransparentColor(Col : TColor);
-    Function GetTransparentColor : TColor;
-    property TransparentColorSet : boolean read TransparentSet;
     procedure FastDrawClear(Color : TColor);
     procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);
     procedure FastReplaceColor(OldColor, NewColor: TColor);
@@ -88,6 +85,9 @@ type
     procedure LoadFromTBitmap(bmp: TBitmap);
     procedure LoadFromRawImage(RawImage: TRawImage);
     function CreateTMask : TMask;
+    procedure SetTransparentColor(Col : TColor);
+    function GetTransparentColor : TColor;
+    property TransparentColorSet : boolean read FTransparentSet;
     constructor Create;
     destructor Destroy;override;
   end;
@@ -210,6 +210,7 @@ function TMBitmaps.AddBMP(_bmp: TMufasaBitmap): Integer;
 begin
   Result := GetNewIndex;
   BmpArray[Result] := _bmp;
+  BmpArray[result].Index:= Result;
 end;
 
 function TMBitmaps.CopyBMP(Bitmap: integer): Integer;
@@ -446,6 +447,7 @@ begin;
   Result.R := Color and $ff;
   Result.G := Color shr 8 and $ff;
   Result.B := Color shr 16 and $ff;
+  Result.A := 0;
 end;
 
 function TMufasaBitmap.Copy: TMufasaBitmap;
@@ -698,14 +700,14 @@ end;
 
 procedure TMufasaBitmap.SetTransparentColor(Col: TColor);
 begin
-  TransparentColor:= RGBToBGR(Col);
-  TransparentSet:= True;
+  self.FTransparentSet:= True;
+  self.FTransparentColor:= RGBToBGR(Col);
 end;
 
 function TMufasaBitmap.GetTransparentColor: TColor;
 begin
-  if TransparentSet then
-    Result := BGRToRGB(TransparentColor)
+  if FTransparentSet then
+    Result := BGRToRGB(FTransparentColor)
   else
     raise Exception.CreateFmt('Transparent color for Bitmap[%d] isn''t set',[index]);
 end;
@@ -731,16 +733,16 @@ var
   MinW,MinH,TargetW,TargetH : Integer;
   loopx,loopy : integer;
 begin
-  ValidatePoint(x,y);
+  TargetBitmap.ValidatePoint(x,y);
   TargetW := TargetBitmap.Width;
   TargetH := TargetBitmap.height;
   MinW := Min(w-1,TargetW-x-1);
   MinH := Min(h-1,TargetH-y-1);
-  if TransparentSet then
+  if FTransparentSet then
   begin;
     for loopy := 0 to MinH do
       for loopx := 0 to MinW do
-        if LongWord(FData[loopy * w + loopx]) <> LongWord(TransparentColor) then
+        if LongWord(FData[loopy * w + loopx]) <> LongWord(FTransparentColor) then
           TargetBitmap.FData[(loopy + y) * TargetW + loopx + x] := FData[Loopy * w + loopx];
 
   end
@@ -1227,7 +1229,7 @@ constructor TMufasaBitmap.Create;
 begin
   inherited Create;
   Name:= '';
-  TransparentSet:= False;
+  FTransparentSet:= False;
   setSize(0,0);
   {FData:= nil;
   w := 0;

Units/PascalScript/x86.inc

@@ -573,7 +573,7 @@ begin
               btchar,btU8, btS8:    tbtu8(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
               {$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16:  tbtu16(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
               btClass :
-              {$IFDEF FPC_OLD_FIX}
+              {$IFDEF FPC}
               tbtu32(res.dta^) := RealCall_Register(Address, EDX, EAX, ECX,
               @Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil);
               {$ELSE}