moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2025-03-03 02:41:54 -05:00
Code Issues Releases Wiki Activity

Added Disguise+Status+ClearDebugImg..

Browse Source 
Redesigned the way form-interactions are done.
This commit is contained in:
Raymond 2010-08-18 01:22:03 +02:00
parent 4810850ad1
commit 807905c896
9 changed files with 137 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
Projects/Simba/debugimage.pas
View File

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

9
Projects/Simba/framescript.pas
View File

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

5
Projects/Simba/simbaunit.lfm
View File

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

75
Projects/Simba/simbaunit.pas
View File

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

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

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

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

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

62
Units/MMLAddon/mmlpsthread.pas
View File

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

2
Units/MMLCore/bitmaps.pas
View File

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

6
Units/MMLCore/dtm.pas
View File

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