diff --git a/Projects/Simba/debugimage.pas b/Projects/Simba/debugimage.pas index 53b8dca..f96ab0c 100644 --- a/Projects/Simba/debugimage.pas +++ b/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 GetDebugImage; - procedure ShowDebugImgForm; //Uses the global var for w/h + procedure DrawBitmap(ToDrawBmp: TMufasaBitmap); + procedure GetDebugImage(GetDbgBmp : TMufasaBitmap); + 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; diff --git a/Projects/Simba/framescript.pas b/Projects/Simba/framescript.pas index 7e14c97..79e6ac4 100644 --- a/Projects/Simba/framescript.pas +++ b/Projects/Simba/framescript.pas @@ -162,8 +162,7 @@ begin if not ScriptChanged then begin; ScriptChanged:= True; - SimbaForm.Caption:= Format(WindowTitle,[ScriptName + '*']); - OwnerSheet.Caption:=ScriptName + '*'; + SimbaForm.UpdateTitle; end; end; @@ -520,8 +519,7 @@ begin if ScriptChanged then if SynEdit.Lines.Text = StartText then begin; - SimbaForm.Caption:= format(WindowTitle,[ScriptName]); - OwnerSheet.Caption:= ScriptName; + SimbaForm.UpdateTitle; ScriptChanged := false; end; end; @@ -532,8 +530,7 @@ begin if ScriptChanged then if SynEdit.Lines.Text = StartText then begin; - SimbaForm.Caption:= format(WindowTitle,[ScriptName]); - OwnerSheet.Caption := ScriptName; + SimbaForm.UpdateTitle; ScriptChanged := false; end; end; diff --git a/Projects/Simba/simbaunit.lfm b/Projects/Simba/simbaunit.lfm index 4739f16..b3f248a 100644 --- a/Projects/Simba/simbaunit.lfm +++ b/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 diff --git a/Projects/Simba/simbaunit.pas b/Projects/Simba/simbaunit.pas index 8bd2d3e..d932e8d 100644 --- a/Projects/Simba/simbaunit.pas +++ b/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; - StatusBar.Panels[Panel_ScriptPath].text:= ScriptFile; + UpdateTitle; 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; diff --git a/Units/MMLAddon/PSInc/Wrappers/other.inc b/Units/MMLAddon/PSInc/Wrappers/other.inc index 7196529..bacbde7 100644 --- a/Units/MMLAddon/PSInc/Wrappers/other.inc +++ b/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.DebugClear(); + CurrThread.FormCallBack(m_ClearDebug,nil); 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); - CurrThread.Synchronize( CurrThread.DebugImg.ShowForm); + DispSize := Classes.Point(w,h); + Currthread.FormCallBack(m_DisplayDebugImgWindow,@DispSize); end; procedure ps_DrawBitmapDebugImg(bmp : integer); extdecl; +var + mbmp : TMufasaBitmap; begin; - CurrThread.DebugImg.ToDrawBitmap^ := CurrThread.Client.MBitmaps[bmp]; - CurrThread.Synchronize(CurrThread.DebugImg.DrawBitmap); + mbmp := CurrThread.Client.MBitmaps[bmp]; + 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]; - CurrThread.Synchronize(CurrThread.DebugImg.GetBitmap); + mbmp := CurrThread.Client.MBitmaps[result]; + 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; diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index ac7ec16..719a7af 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/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;'); diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index b77d75b..4fd685a 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/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; diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas index 349c1ba..cda2ac6 100644 --- a/Units/MMLCore/bitmaps.pas +++ b/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) diff --git a/Units/MMLCore/dtm.pas b/Units/MMLCore/dtm.pas index e42bf2c..6b6af12 100644 --- a/Units/MMLCore/dtm.pas +++ b/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;