Added Disguise+Status+ClearDebugImg..

Redesigned the way form-interactions are done.

Projects/Simba/debugimage.pas

@@ -42,13 +42,10 @@ type
   private
     { private declarations }
   public
-    DispSize : TPoint;
-    ToDrawBmp: TMufasaBitmap;//The bitmap we should draw!
-    GetDbgBmp : TMufasaBitmap;
     procedure BlackDebugImage;
-    procedure DrawBitmap;
+    procedure DrawBitmap(ToDrawBmp: TMufasaBitmap);
-    procedure GetDebugImage;
+    procedure GetDebugImage(GetDbgBmp : TMufasaBitmap);
-    procedure ShowDebugImgForm; //Uses the global var for w/h
+    procedure ShowDebugImgForm(DispSize : TPoint);
     { public declarations }
   end;
 
@@ -87,7 +84,7 @@ begin
   DrawImage.Repaint;
 end;
 
-procedure TDebugImgForm.DrawBitmap;
+procedure TDebugImgForm.DrawBitmap(ToDrawBmp : TMufasaBitmap);
 var
   Bitmap : Graphics.TBitmap;
 begin
@@ -99,12 +96,12 @@ begin
   Bitmap.Free;
 end;
 
-procedure TDebugImgForm.GetDebugImage;
+procedure TDebugImgForm.GetDebugImage(GetDbgBmp : TMufasaBitmap);
 begin;
   GetDbgBmp.LoadFromRawImage(DrawImage.Picture.Bitmap.RawImage);
 end;
 
-procedure TDebugImgForm.ShowDebugImgForm;
+procedure TDebugImgForm.ShowDebugImgForm(DispSize : TPoint);
 begin
   if not Visible then
     show;

Projects/Simba/framescript.pas

@@ -162,8 +162,7 @@ begin
   if not ScriptChanged then
   begin;
     ScriptChanged:= True;
-    SimbaForm.Caption:= Format(WindowTitle,[ScriptName + '*']);
+    SimbaForm.UpdateTitle;
-    OwnerSheet.Caption:=ScriptName + '*';
   end;
 end;
 
@@ -520,8 +519,7 @@ begin
   if ScriptChanged then
     if SynEdit.Lines.Text = StartText then
     begin;
-      SimbaForm.Caption:= format(WindowTitle,[ScriptName]);
+      SimbaForm.UpdateTitle;
-      OwnerSheet.Caption:= ScriptName;
       ScriptChanged := false;
     end;
 end;
@@ -532,8 +530,7 @@ begin
   if ScriptChanged then
     if SynEdit.Lines.Text = StartText then
     begin;
-      SimbaForm.Caption:= format(WindowTitle,[ScriptName]);
+      SimbaForm.UpdateTitle;
-      OwnerSheet.Caption := ScriptName;
       ScriptChanged := false;
     end;
 end;

Projects/Simba/simbaunit.lfm

@@ -1,7 +1,7 @@
 object SimbaForm: TSimbaForm
-  Left = 602
+  Left = 674
   Height = 623
-  Top = 75
+  Top = 308
   Width = 660
   AllowDropFiles = True
   Caption = 'THA FUKING Simba'
@@ -1260,7 +1260,6 @@ object SimbaForm: TSimbaForm
       end
       object MenuItemExtensions: TMenuItem
         Action = ActionExtensions
-        OnClick = MenuItemExtensionsClick
       end
     end
     object MenuTools: TMenuItem

Projects/Simba/simbaunit.pas

@@ -20,9 +20,6 @@
 
     Simba/GUI for the Mufasa Macro Library
 }
-
-{TODO: Implement Disguise and Status bars}
-
 unit SimbaUnit;
 
 {$undef EditButtons}
@@ -404,16 +401,18 @@ type
     Picker: TMColorPicker;
     Selector: TMWindowSelector;
     OnScriptStart : TScriptStartEvent;
+    FormCallBackData : TCallBackData;
     {$ifdef mswindows}
     ConsoleVisible : boolean;
     procedure ShowConsole( ShowIt : boolean);
     {$endif}
 
+    procedure FormCallBack;
     function LoadSettingDef(const Key, Def : string) : string;
-
     procedure FunctionListShown( ShowIt : boolean);
     property ScriptState : TScriptState read GetScriptState write SetScriptState;
     procedure SafeCallThread;
+    procedure UpdateTitle;
     function OpenScript : boolean;
     function LoadScriptFile(filename : string; AlwaysOpenInNewTab : boolean = false; CheckOtherTabs : boolean = true) : boolean;
     function SaveCurrentScript : boolean;
@@ -464,6 +463,7 @@ const
   Panel_Coords = 1;
   Panel_ScriptName = 2;
   Panel_ScriptPath = 3;
+  Panel_General = 3;
 
 
   Image_Stop = 7;
@@ -484,6 +484,7 @@ uses
    files,
    InterfaceBase,
    bitmapconv,
+   bitmaps,
    extensionmanagergui,
    colourhistory,
    math;
@@ -1139,17 +1140,6 @@ begin
   Script := Tab.ScriptFrame;
   Self.CurrScript := Script;
   Self.CurrTab := Tab;
-  if Script.ScriptChanged then
-  begin;
-    Tab.TabSheet.Caption:= Script.ScriptName + '*';
-    Self.Caption := Format(WindowTitle,[Script.ScriptName + '*'])
-  end else
-  begin;
-    Tab.TabSheet.Caption:= Script.ScriptName;
-    Self.Caption := Format(WindowTitle,[Script.ScriptName]);
-  end;
-  StatusBar.Panels[Panel_ScriptName].Text:= Script.ScriptName;
-  StatusBar.Panels[Panel_ScriptPath].text:= Script.ScriptFile;
   SetScriptState(Tab.ScriptFrame.FScriptState);//To set the buttons right
   if Self.Showing then
     if Tab.TabSheet.TabIndex = Self.PageControl1.TabIndex then
@@ -1410,7 +1400,6 @@ end;
 
 procedure TSimbaForm.InitalizeTMThread(var Thread: TMThread);
 var
-  DbgImgInfo : TDbgImgInfo;
   AppPath : string;
   ScriptPath : string;
   UseCPascal: String;
@@ -1442,18 +1431,12 @@ begin
   end;
   {$IFNDEF TERMINALWRITELN}
   Thread.SetDebug(@formWriteln);
-  Thread.SetDebugClear(@ClearDebug);
   {$ENDIF}
   Thread.SetScript(Script);
-  DbgImgInfo.DispSize := @DebugImgForm.DispSize;
-  DbgImgInfo.ShowForm := @DebugImgForm.ShowDebugImgForm;
-  DbgImgInfo.ToDrawBitmap:= @DebugImgForm.ToDrawBmp;
-  DbgImgInfo.DrawBitmap:= @DebugImgForm.DrawBitmap;
-  DbgImgInfo.GetDebugBitmap:= @DebugImgForm.GetDbgBmp;
-  DbgImgInfo.GetBitmap:= @DebugImgForm.GetDebugImage;
-  Thread.SetDbgImg(DbgImgInfo);
   Thread.ErrorData:= @CurrScript.ErrorData;
   Thread.OnError:= @CurrScript.HandleErrorData;
+  FormCallBackData.FormCallBack:= @self.FormCallBack;
+  Thread.CallBackData:=@FormCallBackData;
 
   if CurrScript.ScriptFile <> '' then
     ScriptPath := IncludeTrailingPathDelimiter(ExtractFileDir(CurrScript.ScriptFile));
@@ -1546,11 +1529,9 @@ begin
     StartText:= SynEdit.Lines.Text;
     ScriptChanged := false;
     SynEdit.MarkTextAsSaved;
-    Self.Caption:= Format(WindowTitle,[ScriptName]);
     CurrTab.TabSheet.Caption:= ScriptName;
     Self.AddRecentFile(ScriptFile);
-    StatusBar.Panels[Panel_ScriptName].Text:= ScriptName;
+    UpdateTitle;
-    StatusBar.Panels[Panel_ScriptPath].text:= ScriptFile;
   end;
 end;
 
@@ -1965,11 +1946,11 @@ begin
   if node = nil then
     exit;
   if Node.level = 0 then
-    StatusBar.Panels[Panel_ScriptPath].Text := 'Section: ' + Node.Text;
+    StatusBar.Panels[Panel_General].Text := 'Section: ' + Node.Text;
   if (Node.Level > 0) and (Node.Data <> nil) then
   begin
     MethodInfo := PMethodInfo(node.Data)^;
-    StatusBar.Panels[Panel_ScriptPath].Text := MethodInfo.MethodStr;
+    StatusBar.Panels[Panel_General].Text := MethodInfo.MethodStr;
   end;
 end;
 
@@ -2211,6 +2192,7 @@ begin
   FillThread.Resume;
   //Load the extensions
   LoadExtensions;
+  UpdateTitle;
   self.EndFormUpdate;
 end;
 
@@ -2565,6 +2547,7 @@ end;
 procedure TSimbaForm.PageControl1Change(Sender: TObject);
 begin
   RefreshTab();
+  UpdateTitle;
 end;
 
 procedure TSimbaForm.ButtonTrayClick(Sender: TObject);
@@ -2869,8 +2852,23 @@ begin
   end else
     Writeln('You cannot hide the window, since its not created by Simba');
 end;
+
 {$endif}
 
+procedure TSimbaForm.FormCallBack;
+begin
+  with FormCallBackData do
+    case Cmd of
+      m_Status: StatusBar.Panels[Panel_General].Text:= PChar(data);
+      m_Disguise: Self.Caption:= Pchar(Data);
+      m_DisplayDebugImgWindow: DebugImgForm.ShowDebugImgForm(ppoint(data)^);
+      m_DrawBitmapDebugImg: DebugImgForm.DrawBitmap(TMufasaBitmap(data));
+      m_GetDebugBitmap : DebugImgForm.GetDebugImage(TMufasaBitmap(data));
+      m_ClearDebugImg : DebugImgForm.BlackDebugImage;
+      m_ClearDebug : Self.memo1.clear;
+    end;
+end;
+
 procedure TSimbaForm.FunctionListShown(ShowIt: boolean);
 begin
   with MenuItemFunctionList, frmFunctionList do
@@ -2930,6 +2928,21 @@ begin
   end;
 end;
 
+procedure TSimbaForm.UpdateTitle;
+begin
+  if CurrScript.ScriptChanged then
+  begin;
+    CurrTab.TabSheet.Caption:= CurrScript.ScriptName + '*';
+    Self.Caption := Format(WindowTitle,[CurrScript.ScriptName + '*'])
+  end else
+  begin;
+    CurrTab.TabSheet.Caption:= CurrScript.ScriptName;
+    Self.Caption := Format(WindowTitle,[CurrScript.ScriptName]);
+  end;
+  StatusBar.Panels[Panel_ScriptName].Text:= CurrScript.ScriptName;
+  StatusBar.Panels[Panel_ScriptPath].text:= CurrScript.ScriptFile;
+end;
+
 function TSimbaForm.OpenScript: boolean;
 var
   i: Integer;
@@ -2962,6 +2975,8 @@ begin
   finally
     Free;
   end;
+  if result then
+    UpdateTitle;
 end;
 
 function TSimbaForm.LoadScriptFile(filename: string; AlwaysOpenInNewTab: boolean; CheckOtherTabs : boolean
@@ -3006,6 +3021,8 @@ begin
       Result := True;
     end;
   end;
+  if Result then
+    UpdateTitle;
 end;
 
 function TSimbaForm.SaveCurrentScript: boolean;

Units/MMLAddon/PSInc/Wrappers/other.inc

@@ -126,8 +126,7 @@ end;
 {$IFNDEF MML_EXPORT_THREADSAFE}
 procedure ps_ClearDebug; extdecl;
 begin
-  if Assigned(CurrThread.DebugClear) then
+  CurrThread.FormCallBack(m_ClearDebug,nil);
-    CurrThread.DebugClear();
 end;
 
 procedure ps_SetSupressExceptions(Supress : boolean);extdecl;
@@ -150,22 +149,49 @@ end;
 
 
 procedure ps_DisplayDebugImgWindow(w,h : integer); extdecl;
+var
+  DispSize : TPoint;
 begin;
-  CurrThread.DebugImg.DispSize^ := Classes.Point(w,h);
+  DispSize := Classes.Point(w,h);
-  CurrThread.Synchronize( CurrThread.DebugImg.ShowForm);
+  Currthread.FormCallBack(m_DisplayDebugImgWindow,@DispSize);
 end;
 
 procedure ps_DrawBitmapDebugImg(bmp : integer); extdecl;
+var
+  mbmp : TMufasaBitmap;
 begin;
-  CurrThread.DebugImg.ToDrawBitmap^ := CurrThread.Client.MBitmaps[bmp];
+  mbmp := CurrThread.Client.MBitmaps[bmp];
-  CurrThread.Synchronize(CurrThread.DebugImg.DrawBitmap);
+  CurrThread.FormCallBack(m_DrawBitmapDebugImg,Pointer(mbmp));
 end;
 
 function ps_GetDebugBitmap : integer; extdecl;
+var
+  mbmp : TMufasaBitmap;
 begin;
   result := CurrThread.Client.MBitmaps.CreateBMP(0,0);
-  CurrThread.DebugImg.GetDebugBitmap^ := CurrThread.Client.MBitmaps[result];
+  mbmp := CurrThread.Client.MBitmaps[result];
-  CurrThread.Synchronize(CurrThread.DebugImg.GetBitmap);
+  CurrThread.FormCallBack(m_GetDebugBitmap,pointer(mbmp));
+end;
+
+procedure ps_ClearDebugImg; extdecl;
+begin
+  CurrThread.FormCallBack(m_ClearDebugImg,nil);
+end;
+
+procedure ps_Status(Status : string); extdecl;
+var
+  PStatus : PChar;
+begin
+  PStatus:= PChar(Status);
+  CurrThread.FormCallBack(m_Status,PStatus);
+end;
+
+procedure ps_Disguise(Caption : string); extdecl;
+var
+  PCaption : PChar;
+begin
+  PCaption := PChar(Caption);
+  CurrThread.FormCallBack(m_Disguise,PCaption);
 end;
 
 procedure ps_TerminateScript; extdecl;

Units/MMLAddon/PSInc/psexportedmethods.inc

@@ -181,7 +181,10 @@ AddFunction(@ps_StopSound,'procedure StopSound;');
 AddFunction(@ps_DisplayDebugImgWindow,'procedure DisplayDebugImgWindow(w, h: integer);');
 AddFunction(@ps_DrawBitmapDebugImg,'procedure DrawBitmapDebugImg(bmp: integer);');
 AddFunction(@ps_GetDebugBitmap,'function GetDebugBitmap: integer;');
+AddFunction(@ps_ClearDebugImg,'procedure ClearDebugImg;');
 AddFunction(@ps_ClearDebug,'procedure ClearDebug;');
+AddFunction(@ps_Status,'procedure Status(Status : string);');
+AddFunction(@ps_Disguise,'procedure Disguise(Caption : string);');
 AddFunction(@ps_SetScriptProp, 'function SetScriptProp(Prop : TSP_Property; Value: TVariantArray): boolean;');
 AddFunction(@ps_GetScriptProp, 'function GetScriptProp(Prop : TSP_Property;var Value: TVariantArray): boolean;');
 AddFunction(@ps_InputQuery,'function InputQuery(const ACaption, APrompt : String; var Value : String) : Boolean;');

Units/MMLAddon/mmlpsthread.pas

@@ -35,9 +35,22 @@ uses
   bitmaps, plugins, libloader, dynlibs,internets,scriptproperties,
   settings,settingssandbox;
 
-
+const
+  m_Status = 0; //Data = PChar to new status
+  m_Disguise = 1; //Data = PChar to new title
+  m_DisplayDebugImgWindow = 2; //Data = PPoint to window size
+  m_DrawBitmapDebugImg = 3; //Data = TMufasaBitmap
+  m_GetDebugBitmap = 4; //Data = TMufasaBitmap
+  m_ClearDebugImg = 5; //Data = nil
+  m_ClearDebug = 6; //Data = nil
 type
     { TMMLPSThread }
+    TCallBackData = record
+      FormCallBack : procedure of object;
+      cmd : integer;
+      data : pointer;
+    end;
+    PCallBackData = ^TCallBackData;
     TSyncInfo = record
       V : MufasaTypes.PVariantArray;
       MethodName : string;
@@ -46,15 +59,6 @@ type
       OldThread : TThread;
     end;
 
-    TClearDebugProc = procedure;
-    TDbgImgInfo = record
-      DispSize : ^TPoint;
-      ShowForm : procedure of object;
-      ToDrawBitmap : ^TMufasaBitmap;
-      DrawBitmap : procedure of object;
-      GetDebugBitmap : ^TMufasaBitmap;
-      GetBitmap : procedure of object;
-    end;
     PSyncInfo = ^TSyncInfo;
     TErrorType = (errRuntime,errCompile);
     TOnError = procedure of object;
@@ -86,8 +90,6 @@ type
     protected
       ScriptPath, AppPath, IncludePath, PluginPath, FontPath: string;
       DebugTo: TWritelnProc;
-      FDebugClear : TClearDebugProc;
-      FDebugImg : TDbgImgInfo;
       ExportedMethods : TExpMethodArr;
       Includes : TStringList;
       FOpenConnectionEvent : TOpenConnectionEvent;
@@ -104,6 +106,7 @@ type
       SimbaSettingsFile: String;
       Sett: TMMLSettingsSandbox;
 
+      CallBackData : PCallBackData; //Handles general callback functions for threadsafety
       InputQueryData : TInputQueryData;//We need this for InputQuery
       SyncInfo : PSyncInfo; //We need this for callthreadsafe
       ErrorData : PErrorData; //We need this for thread-safety etc
@@ -111,6 +114,8 @@ type
 
       CompileOnly : boolean;
 
+      procedure FormCallBackEx(cmd : integer; var data : pointer);
+      procedure FormCallBack(cmd : integer; data : pointer);
       procedure mInputQuery;
       procedure HandleError(ErrorRow,ErrorCol,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType; ErrorModule : string);
       function ProcessDirective(DirectiveName, DirectiveArgs: string): boolean;
@@ -118,8 +123,6 @@ type
       procedure AddMethod(meth: TExpMethod); virtual;
 
       procedure SetDebug( writelnProc : TWritelnProc );
-      procedure SetDebugClear( clearProc : TClearDebugProc );
-      procedure SetDbgImg( DebugImageInfo : TDbgImgInfo);
       procedure SetPaths(ScriptP,AppP,IncludeP,PluginP,FontP : string);
       procedure SetSettings(S: TMMLSettings; SimbaSetFile: String);
 
@@ -136,8 +139,6 @@ type
       property OpenConnectionEvent : TOpenConnectionEvent read FOpenConnectionEvent write SetOpenConnectionEvent;
       property WriteFileEvent : TWriteFileEvent read FWriteFileEvent write SetWriteFileEvent;
       property OpenFileEvent : TOpenFileEvent read FOpenFileEvent write SetOpenFileEvent;
-      property DebugClear : TClearDebugProc read FDebugClear write SetDebugClear;
-      property DebugImg : TDbgImgInfo read FDebugImg write SetDbgImg;
     end;
 
     { TPSThread }
@@ -318,6 +319,25 @@ begin
     self.Client.MFiles.WriteFileEvent := AValue;;
 end;
 
+procedure TMThread.FormCallBackEx(cmd: integer; var data: pointer);
+begin
+  if (CallBackData = nil) or not Assigned(CallBackData^.FormCallBack) then
+    exit;
+  CallBackData^.cmd:= cmd;
+  CallBackData^.data:= data;
+  Synchronize(CallBackData^.FormCallBack);
+  data := CallBackData^.data;
+end;
+
+procedure TMThread.FormCallBack(cmd: integer; data: pointer);
+begin
+  if (CallBackData = nil) or (not Assigned(CallBackData^.FormCallBack)) then
+    exit;
+  CallBackData^.cmd:= cmd;
+  CallBackData^.data:= data;
+  Synchronize(CallBackData^.FormCallBack);
+end;
+
 procedure TMThread.mInputQuery;
 begin
   InputQueryData.Res:= InputQuery(InputQueryData.ACaption,InputQueryData.APrompt,
@@ -419,16 +439,6 @@ begin
   Client.WritelnProc:= writelnProc;
 end;
 
-procedure TMThread.SetDebugClear(clearProc: TClearDebugProc);
-begin
-  FDebugClear:= clearProc;
-end;
-
-procedure TMThread.SetDbgImg(DebugImageInfo: TDbgImgInfo);
-begin
-  FDebugImg := DebugImageInfo;
-end;
-
 procedure TMThread.SetSettings(S: TMMLSettings; SimbaSetFile: String);
 begin
   Self.SimbaSettingsFile := SimbaSetFile;

Units/MMLCore/bitmaps.pas

@@ -96,7 +96,7 @@ type
     constructor Create;
     destructor Destroy;override;
   end;
-
+  PMufasaBitmap = ^TMufasaBitmap;
   TMufasaBmpArray = Array of TMufasaBitmap;
   { TMBitmaps }
   TMBitmaps = class(TObject)

Units/MMLCore/dtm.pas

@@ -44,6 +44,7 @@ type
       Name : string;
       Index : integer;
       function ToString : string;
+      function SaveToFile(const FileName : string) : boolean;
       function LoadFromString(const s : string) : boolean;
       procedure Normalize;
       function Valid : boolean;
@@ -285,6 +286,11 @@ begin
   Freemem(start,len);
 end;
 
+function TMDTM.SaveToFile(const FileName: string): boolean;
+begin
+
+end;
+
 function TMDTM.LoadFromString(const s: string): boolean;
 var
   MDTM : TMDTM;