1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-24 16:28:53 -05:00
Simba/Projects/SAMufasaGUI/testunit.pas
Raymond 3b603917a0 FindDeformedBitmapToleranceIn has been improved! Is zeh win now. (beats scar, imo).
Oh and we can now type more than 80 chars a line (in synedit).


git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@147 3f818213-9676-44b0-a9b4-5e4c4e03d09d
2009-10-22 14:25:20 +00:00

438 lines
12 KiB
ObjectPascal

{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
TestUnit/GUI for the Mufasa Macro Library
}
unit TestUnit;
{$Undef ProcessMessages} //Define this for processmessages in ThreadSafeCall
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Menus, ComCtrls, ExtCtrls, SynEdit, SynHighlighterPas, SynMemo,
//Client,
MufasaTypes,
mmlpsthread,
window, // for the comp picker and selector
colourpicker,
windowselector,
lcltype
, SynEditKeyCmds;
type
{ TForm1 }
TForm1 = class(TForm)
Memo1: TMemo;
MenuFile: TMenuItem;
MenuEdit: TMenuItem;
MenuItemNew: TMenuItem;
MenuItemSaveAs: TMenuItem;
MenuItemOpen: TMenuItem;
MenuItemRedo: TMenuItem;
MenuItemUndo: TMenuItem;
MenuItemSave: TMenuItem;
Mufasa_Image_List: TImageList;
MainMenu1: TMainMenu;
MenuItemScript: TMenuItem;
MenuItemRun: TMenuItem;
StatusBar: TStatusBar;
SynEdit1: TSynEdit;
SynFreePascalSyn1: TSynFreePascalSyn;
ToolBar1: TToolBar;
TB_Run: TToolButton;
TB_Pause: TToolButton;
TB_Stop: TToolButton;
ToolButton1: TToolButton;
TB_ReloadPlugins: TToolButton;
TB_Tray: TToolButton;
TB_NewTab: TToolButton;
TB_CloseTab: TToolButton;
ToolButton4: TToolButton;
TB_ClearDebug: TToolButton;
TB_PickColour: TToolButton;
TB_SelectClient: TToolButton;
ToolButton8: TToolButton;
TB_Convert: TToolButton;
MTrayIcon: TTrayIcon;
procedure Button1Click(Sender: TObject);
procedure ClearDebug(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure MenuFileClick(Sender: TObject);
procedure MenuItemNewClick(Sender: TObject);
procedure MenuItemOpenClick(Sender: TObject);
procedure MenuItemRunClick(Sender: TObject);
procedure MenuItemSaveAsClick(Sender: TObject);
procedure MenuItemSaveClick(Sender: TObject);
procedure OnLinePSScript(Sender: TObject);
procedure OnSyneditChange(Sender: TObject);
procedure PickColorEvent(Sender: TObject);
procedure Redo(Sender: TObject);
procedure Selector_DOWN(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure NoTray(Sender: TObject);
procedure SynEditProcessCommand(Sender: TObject;
var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer);
procedure ToolBar1Click(Sender: TObject);
procedure ToTray(Sender: TObject);
procedure Undo(Sender: TObject);
private
ScriptFile : string;//The path to the saved/opened file currently in the SynEdit
StartText : string;//The text synedit holds upon start/open/save
ScriptName : string;//The name of the currently opened/saved file.
ScriptDefault : string;//The default script e.g. program new; begin end.
ScriptChanged : boolean;//We need this for that little * (edited star).
public
Window: TMWindow;
Picker: TMColorPicker;
Selector: TMWindowSelector;
procedure SafeCallThread;
function OpenScript : boolean;
function SaveCurrentScript : boolean;
function SaveCurrentScriptAs : boolean;
function CanExitOrOpen : boolean;
function ClearScript : boolean;
procedure run;
end;
const
WindowTitle = 'Mufasa v2 - %s';//Title, where %s = the place of the filename.
var
Form1: TForm1;
MainDir : string;
CurrentSyncInfo : TSyncInfo;//We need this for SafeCallThread
implementation
uses
lclintf,plugins;
procedure TForm1.Run;
Var
MMLPSThread : TMMLPSThread;
begin
CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread;
MMLPSThread := TMMLPSThread.Create(True,@CurrentSyncInfo);
MMLPSThread.SetPSScript(Self.SynEdit1.Lines.Text);
MMLPSThread.SetDebug(Self.Memo1);
if ScriptFile <> '' then
MMLPSThread.SetPaths( ExtractFileDir(ScriptFile) + DS,IncludeTrailingPathDelimiter(ExpandFileName(MainDir +DS + '..' + DS + '..' + ds)))
else
MMLPSThread.SetPaths('', IncludeTrailingPathDelimiter(ExpandFileName(MainDir +DS + '..' + DS + '..' + ds)));
// This doesn't actually set the Client's MWindow to the passed window, it
// only copies the current set window handle.
MMLPSThread.Client.MWindow.SetWindow(Self.Window);
MMLPSThread.Resume;
// sleep(500);
// MMLPSThread.PSScript.Stop;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin;
Run;
end;
procedure TForm1.ClearDebug(Sender: TObject);
begin
Memo1.Clear;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
if not CanExitOrOpen then
CloseAction := caNone;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Window := TMWindow.Create;
Picker := TMColorPicker.Create(Window);
Selector := TMWindowSelector.Create(Window);
StartText:= SynEdit1.Lines.text;
ScriptDefault:= StartText;
Caption := Format(WindowTitle,['Untitled']);
ScriptName:= 'Untitled';
ScriptChanged := false;
MainDir:= ExtractFileDir(Application.ExeName);
PluginsGlob := TMPlugins.Create;
PluginsGlob.PluginDirs.Add(ExpandFileName(MainDir + DS + '..' + DS + '..'+ DS + 'Plugins'+ DS));
// SynMemo1.sc
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Selector.Free;
Picker.Free;
Window.Free;
PluginsGlob.Free;
end;
procedure TForm1.MenuFileClick(Sender: TObject);
begin
end;
procedure TForm1.MenuItemNewClick(Sender: TObject);
begin
ClearScript;
end;
procedure TForm1.MenuItemOpenClick(Sender: TObject);
begin
OpenScript;
end;
procedure TForm1.MenuItemRunClick(Sender: TObject);
begin
Run;
end;
procedure TForm1.MenuItemSaveAsClick(Sender: TObject);
begin
SaveCurrentScriptAs;
end;
procedure TForm1.MenuItemSaveClick(Sender: TObject);
begin
SaveCurrentScript;
end;
procedure TForm1.OnLinePSScript(Sender: TObject);
begin
//Writeln('We just completed a line!!');
{$IFDEF ProcessMessages}
Application.ProcessMessages; //Don't think that this is neccesary though
{$ENDIF}
end;
procedure TForm1.OnSyneditChange(Sender: TObject);
begin
if not ScriptChanged then
begin;
ScriptChanged:= True;
Self.Caption:= Format(WindowTitle,[ScriptName + '*']);
end;
end;
procedure TForm1.PickColorEvent(Sender: TObject);
var
c, x, y: Integer;
begin
Picker.Pick(c, x, y);
writeln('Picked colour: ' + inttostr(c) + ' at (' + inttostr(x) + ', ' + inttostr(y) + ')');
end;
procedure TForm1.Redo(Sender: TObject);
begin
SynEdit1.Redo;
if ScriptChanged then
if SynEdit1.Lines.Text = StartText then
begin;
Self.Caption:= format(WindowTitle,[ScriptName]);
ScriptChanged := false;
end;
end;
procedure TForm1.Selector_DOWN(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Window.SetTarget(Selector.Drag {$ifdef MSWINDOWS},w_window{$endif});
writeln('New window: ' + IntToStr(Window.{$ifdef MSWindows}TargetHandle{$else}CurWindow{$ENDIF}));
end;
procedure TForm1.NoTray(Sender: TObject);
begin
if Not Form1.IsVisible then
Form1.Show
else
Form1.Hide;
end;
procedure TForm1.SynEditProcessCommand(Sender: TObject;
var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer);
begin
if Command = ecUndo then
begin;
Command:= ecNone;
Undo(Sender);
end else
if Command = ecRedo then
begin;
Command := ecNone;
Redo(Sender);
end;
end;
procedure TForm1.ToolBar1Click(Sender: TObject);
begin
end;
procedure TForm1.ToTray(Sender: TObject);
begin
Form1.Hide;
end;
procedure TForm1.Undo(Sender: TObject);
begin
SynEdit1.Undo;
if ScriptChanged then
if SynEdit1.Lines.Text = StartText then
begin;
Self.Caption:= format(WindowTitle,[ScriptName]);
ScriptChanged := false;
end;
end;
procedure TForm1.SafeCallThread;
begin
Writeln('Executing : ' + CurrentSyncInfo.MethodName);
mmlpsthread.CurrThread := TMMLPSTHREAD(CurrentSyncInfo.OldThread);
with CurrentSyncInfo.PSScript do
begin;
OnLine:=@OnLinePSScript;
CurrentSyncInfo.Res:= Exec.RunProcPVar(CurrentSyncInfo.V,Exec.GetProc(CurrentSyncInfo.MethodName));
Online := nil;
end;
mmlpsthread.CurrThread := nil;
end;
function TForm1.OpenScript: boolean;
begin;
Result := False;
if CanExitOrOpen = false then
Exit;
with TOpenDialog.Create(nil) do
try
Filter:= 'Mufasa Files|*.cogat;*.mufa;*.txt|Any files|*.*';
if Execute then
if FileExists(FileName) then
begin;
SynEdit1.Lines.LoadFromFile(FileName);
StartText := SynEdit1.Lines.text;
ScriptName:= ExtractFileNameOnly(FileName);
WriteLn('Script name will be: ' + ScriptName);
ScriptFile:= FileName;
StatusBar.Panels[0].Text:= ScriptName;
StatusBar.Panels[1].text:= FileName;
Self.Caption:= Format(WindowTitle,[ScriptName]);
ScriptChanged := false;
Result := True;
end;
finally
Free;
end;
end;
function TForm1.SaveCurrentScript: boolean;
begin
Result := (ScriptFile <> '');
if Result then
begin;
ScriptChanged := false;
SynEdit1.Lines.SaveToFile(ScriptFile);
StartText:= SynEdit1.Lines.Text;
SynEdit1.MarkTextAsSaved;
Self.Caption:= Format(WindowTitle,[ScriptName]);
end
else
result := SaveCurrentScriptAs;
end;
function TForm1.SaveCurrentScriptAs: boolean;
begin
Result := false;
with TSaveDialog.Create(nil) do
try
Filter:= 'Mufasa files|*.cogat;*.mufa;*.pas;*.txt|Any Files|*.*';
if Execute then
begin;
if ExtractFileExt(FileName) = '' then
begin;
ScriptFile := FileName + '.mufa';
end else
ScriptFile := FileName;
SynEdit1.Lines.SaveToFile(ScriptFile);
ScriptName:= ExtractFileNameOnly(ScriptFile);
StatusBar.Panels[0].Text:= ScriptName;
StatusBar.Panels[1].text := ScriptFile;
Self.Caption:= Format(WindowTitle,[ScriptName]);
WriteLn('Script name will be: ' + ScriptName);
Result := True;
end;
finally
Free;
end;
if result then
begin;
Writeln('Succesfully saved: ' + ScriptFile);
StartText:= SynEdit1.Lines.Text;
SynEdit1.MarkTextAsSaved;
ScriptChanged := false;
end;
end;
function TForm1.CanExitOrOpen: boolean;
var
I : integer;
begin;
Result := True;
if StartText <> Synedit1.Lines.text then
Case MessageBox(0,pchar('Do you want to save the script?'), Pchar('Script has been modified.'),
MB_YESNOCANCEL or MB_ICONQUESTION) of
IDCANCEL : Result := False;
IDYES : Result := SaveCurrentScript;
end;
end;
function TForm1.ClearScript: boolean;
begin
if CanExitOrOpen then
begin;
ScriptFile:= '';
ScriptName:= 'Untitled';
StartText:= ScriptDefault;
SynEdit1.Lines.Text:= ScriptDefault;
StatusBar.Panels[0].Text:= 'Untitled';
StatusBar.Panels[1].Text:= '';
Self.Caption := Format(WindowTitle,['Untitled']);
ScriptChanged:= false;
end;
end;
initialization
{$I testunit.lrs}
end.