diff --git a/Plugins/libsmart.dll b/Plugins/libsmart.dll
index d447b85..fb96b66 100644
Binary files a/Plugins/libsmart.dll and b/Plugins/libsmart.dll differ
diff --git a/Projects/OCRBench/unit1.pas b/Projects/OCRBench/unit1.pas
index 1a8069c..2bd31e3 100644
--- a/Projects/OCRBench/unit1.pas
+++ b/Projects/OCRBench/unit1.pas
@@ -96,7 +96,7 @@ begin
// DS + .. + DS because InitOCR wants the directory of the Fonts, not UpChars
// only.
C.MOCR.InitTOCR(FontPath + DS);
- C.MOCR.SetFonts(C.MOCR.GetFonts);
+ //C.MOCR.SetFonts(C.MOCR.GetFonts);
t:=gettickcount;
@@ -125,6 +125,7 @@ begin
Form1.Image1.Picture.SaveToFile(OCRDebugPath + 'ocrbench.bmp');
{$ENDIF}
+ bmp.OnDestroy:=nil;
bmp.Free;
C.Free;
Application.ProcessMessages;
diff --git a/Projects/SAMufasaGUI/Makefile b/Projects/Simba/Makefile
similarity index 96%
rename from Projects/SAMufasaGUI/Makefile
rename to Projects/Simba/Makefile
index 9d79011..875ff1f 100644
--- a/Projects/SAMufasaGUI/Makefile
+++ b/Projects/Simba/Makefile
@@ -1,4 +1,4 @@
-#$ fpc -MObjFPC -Scgi -O2 -OoREGVAR -gl -vewnhi -l -Fu../../Units/MMLCore/ -Fu../../Units/MMLAddon/ -Fu../../Units/PascalScript/ -Fu../../Units/Misc/ -Fu../../../lazarus/components/synedit/units/x86_64-linux/ -Fu../../../lazarus/ideintf/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/gtk2/ -Fu../../../lazarus/packager/units/x86_64-linux/ -Fu. -oSAMufasaGUI -dUseCThreads -dM_MEMORY_DEBUG -dLCL -dLCLgtk2 project1.lpr
+#$ fpc -MObjFPC -Scgi -O2 -OoREGVAR -gl -vewnhi -l -Fu../../Units/MMLCore/ -Fu../../Units/MMLAddon/ -Fu../../Units/PascalScript/ -Fu../../Units/Misc/ -Fu../../../lazarus/components/synedit/units/x86_64-linux/ -Fu../../../lazarus/ideintf/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/gtk2/ -Fu../../../lazarus/packager/units/x86_64-linux/ -Fu. -oSAMufasaGUI -dUseCThreads -dM_MEMORY_DEBUG -dLCL -dLCLgtk2 Simba.lpr
.PHONY: default clean
@@ -30,6 +30,6 @@ clean:
rm -f *.o *.ppu $(binary)
$(binary):
- $(CC) $(flags) $(units) $(lazarusunits) -o$(binary) $(defines) project1.lpr
+ $(CC) $(flags) $(units) $(lazarusunits) -o$(binary) $(defines) Simba.lpr
-Fu/usr/local/share/lazarus/ideintf/units/x86_64-linux/
diff --git a/Projects/SAMufasaGUI/Makefile.win b/Projects/Simba/Makefile.win
similarity index 96%
rename from Projects/SAMufasaGUI/Makefile.win
rename to Projects/Simba/Makefile.win
index 94389ba..7ba8429 100644
--- a/Projects/SAMufasaGUI/Makefile.win
+++ b/Projects/Simba/Makefile.win
@@ -1,4 +1,4 @@
-#$ fpc -MObjFPC -Scgi -O2 -OoREGVAR -gl -vewnhi -l -Fu../../Units/MMLCore/ -Fu../../Units/MMLAddon/ -Fu../../Units/PascalScript/ -Fu../../Units/Misc/ -Fu../../../lazarus/components/synedit/units/x86_64-linux/ -Fu../../../lazarus/ideintf/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/gtk2/ -Fu../../../lazarus/packager/units/x86_64-linux/ -Fu. -oSAMufasaGUI -dUseCThreads -dM_MEMORY_DEBUG -dLCL -dLCLgtk2 project1.lpr
+#$ fpc -MObjFPC -Scgi -O2 -OoREGVAR -gl -vewnhi -l -Fu../../Units/MMLCore/ -Fu../../Units/MMLAddon/ -Fu../../Units/PascalScript/ -Fu../../Units/Misc/ -Fu../../../lazarus/components/synedit/units/x86_64-linux/ -Fu../../../lazarus/ideintf/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/gtk2/ -Fu../../../lazarus/packager/units/x86_64-linux/ -Fu. -oSAMufasaGUI -dUseCThreads -dM_MEMORY_DEBUG -dLCL -dLCLgtk2 Simba.lpr
.PHONY: default clean
@@ -27,4 +27,4 @@ clean:
del $(binary)
$(binary):
- $(CC) $(flags) $(units) $(lazarusunits) -o$(binary) $(defines) project1.lpr
+ $(CC) $(flags) $(units) $(lazarusunits) -o$(binary) $(defines) Simba.lpr
diff --git a/Projects/SAMufasaGUI/project1.ico b/Projects/Simba/Simba.ico
similarity index 100%
rename from Projects/SAMufasaGUI/project1.ico
rename to Projects/Simba/Simba.ico
diff --git a/Projects/SAMufasaGUI/project1.lpi b/Projects/Simba/Simba.lpi
similarity index 94%
rename from Projects/SAMufasaGUI/project1.lpi
rename to Projects/Simba/Simba.lpi
index 3560cf7..f18cf8d 100644
--- a/Projects/SAMufasaGUI/project1.lpi
+++ b/Projects/Simba/Simba.lpi
@@ -40,19 +40,19 @@
-
+
-
+
-
+
-
+
-
+
-
+
@@ -205,7 +205,7 @@
-
+
@@ -271,7 +271,7 @@
-
+
@@ -288,6 +288,13 @@
+
+
+
+
+
+
+
@@ -319,4 +326,11 @@
+
+
+
+
+
+
+
diff --git a/Projects/SAMufasaGUI/project1.lpr b/Projects/Simba/Simba.lpr
similarity index 83%
rename from Projects/SAMufasaGUI/project1.lpr
rename to Projects/Simba/Simba.lpr
index d94613e..e772d32 100644
--- a/Projects/SAMufasaGUI/project1.lpr
+++ b/Projects/Simba/Simba.lpr
@@ -21,34 +21,35 @@
SAMufasaGUI for the Mufasa Macro Library
}
-program project1;
+program Simba;
{$mode objfpc}{$H+}
-{$DEFINE SIMBA}
+{$DEFINE Simba}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads, cmem,
{$ENDIF}{$ENDIF}
- Interfaces, Forms, testunit, colourhistory, About, internets, debugimage,
- framefunctionlist, simpleanalyzer, updater, updateform, simbasettings,
+ Interfaces, Forms, SimbaUnit, colourhistory, About, internets, debugimage,
+ framefunctionlist, simpleanalyzer, updater, updateform, Simbasettings,
libloader, mufasabase, v_ideCodeInsight, PSDump, v_ideCodeParser,
v_AutoCompleteForm, CastaliaPasLex, CastaliaPasLexTypes, CastaliaSimplePasPar,
CastaliaSimplePasParTypes, dcpbase64, mPasLex, v_Constants, v_MiscFunctions,
- extensionmanagergui, mmisc;
+ extensionmanagergui, mmisc, bitmapconv;
-{$R project1.res}
+{$R Simba.res}
begin
Application.Title:='Simba';
Application.Initialize;
- Application.CreateForm(TForm1, Form1);
+ Application.CreateForm(TSimbaForm, SimbaForm);
Application.CreateForm(TColourHistoryForm, ColourHistoryForm);
Application.CreateForm(TAboutForm, AboutForm);
Application.CreateForm(TDebugImgForm, DebugImgForm);
Application.CreateForm(TExtensionsForm, ExtensionsForm);
+ Application.CreateForm(TBitmapConvForm, BitmapConvForm);
// Application.CreateForm(TSimbaUpdateForm, SimbaUpdateForm);
// Application.CreateForm(TSettingsForm, SettingsForm); Done in FormCreate of MainForm
Application.Run;
diff --git a/Projects/SAMufasaGUI/project1.res b/Projects/Simba/Simba.res
similarity index 100%
rename from Projects/SAMufasaGUI/project1.res
rename to Projects/Simba/Simba.res
diff --git a/Projects/SAMufasaGUI/about.lfm b/Projects/Simba/about.lfm
similarity index 100%
rename from Projects/SAMufasaGUI/about.lfm
rename to Projects/Simba/about.lfm
diff --git a/Projects/SAMufasaGUI/about.pas b/Projects/Simba/about.pas
similarity index 90%
rename from Projects/SAMufasaGUI/about.pas
rename to Projects/Simba/about.pas
index 75b2c61..e47ada0 100644
--- a/Projects/SAMufasaGUI/about.pas
+++ b/Projects/Simba/about.pas
@@ -54,15 +54,15 @@ var
implementation
uses
- TestUnit;
+ SimbaUnit;
{ TAboutForm }
procedure TAboutForm.FormCreate(Sender: TObject);
begin
- Self.Caption := format('About Simba r%d', [TestUnit.SimbaVersion]);
- Self.LabelRevision.Caption := format('Revision %d', [TestUnit.SimbaVersion]);
+ Self.Caption := format('About Simba r%d', [SimbaUnit.SimbaVersion]);
+ Self.LabelRevision.Caption := format('Revision %d', [SimbaUnit.SimbaVersion]);
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(format('You are currently using version: %d',[SimbaUnit.SimbaVersion]));
AboutMemo.Lines.Add('');
AboutMemo.Lines.Add('Please report bugs at: http://mufasa.villavu.com/mantis/');
end;
diff --git a/Projects/Simba/bitmapconv.lfm b/Projects/Simba/bitmapconv.lfm
new file mode 100644
index 0000000..e441d9a
--- /dev/null
+++ b/Projects/Simba/bitmapconv.lfm
@@ -0,0 +1,68 @@
+object BitmapConvForm: TBitmapConvForm
+ Left = 726
+ Height = 240
+ Top = 192
+ Width = 320
+ Caption = 'Bitmap conversion'
+ ClientHeight = 240
+ ClientWidth = 320
+ Constraints.MinHeight = 240
+ Constraints.MinWidth = 320
+ LCLVersion = '0.9.29'
+ object ToStringButton: TButton
+ Left = 192
+ Height = 36
+ Top = 184
+ Width = 113
+ Anchors = [akRight, akBottom]
+ Caption = 'To string'
+ OnClick = ToStringButtonClick
+ TabOrder = 0
+ end
+ object PadOutput: TCheckBox
+ Left = 192
+ Height = 17
+ Top = 160
+ Width = 71
+ Anchors = [akRight, akBottom]
+ Caption = 'Pad output'
+ Checked = True
+ State = cbChecked
+ TabOrder = 1
+ end
+ object OpenButton: TButton
+ Left = 12
+ Height = 36
+ Top = 184
+ Width = 90
+ Anchors = [akRight, akBottom]
+ Caption = 'Open'
+ OnClick = OpenButtonClick
+ TabOrder = 2
+ end
+ object GroupBox: TGroupBox
+ Left = 12
+ Height = 145
+ Top = 8
+ Width = 284
+ Anchors = [akTop, akLeft, akRight, akBottom]
+ Caption = 'Image'
+ ClientHeight = 127
+ ClientWidth = 280
+ TabOrder = 3
+ object ImagePreview: TImage
+ Left = 0
+ Height = 127
+ Top = 0
+ Width = 280
+ Align = alClient
+ Center = True
+ end
+ end
+ object OpenPictureDialog: TOpenPictureDialog
+ FilterIndex = 2
+ Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing, ofViewDetail]
+ left = 128
+ top = 184
+ end
+end
diff --git a/Projects/Simba/bitmapconv.pas b/Projects/Simba/bitmapconv.pas
new file mode 100644
index 0000000..a9e5de9
--- /dev/null
+++ b/Projects/Simba/bitmapconv.pas
@@ -0,0 +1,91 @@
+unit bitmapconv;
+
+{$mode objfpc}{$h+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, bitmaps, LResources, Forms, Controls, Graphics, Dialogs,
+ StdCtrls, EditBtn, ExtDlgs, ExtCtrls;
+
+type
+
+ { TBitmapConvForm }
+
+ TBitmapConvForm = class(TForm)
+ GroupBox: TGroupBox;
+ ToStringButton: TButton;
+ OpenButton: TButton;
+ PadOutput: TCheckBox;
+ ImagePreview: TImage;
+ OpenPictureDialog: TOpenPictureDialog;
+ procedure OpenButtonClick(Sender: TObject);
+ procedure ToStringButtonClick(Sender: TObject);
+ private
+ { private declarations }
+ public
+ dispPic : TMufasaBitmap;
+ { public declarations }
+ end;
+
+var
+ BitmapConvForm: TBitmapConvForm;
+
+implementation
+uses
+ SimbaUnit;
+const
+ BmpSizeTxt = '(%dx%d)';
+{$R *.lfm}
+
+{ TBitmapConvForm }
+
+procedure TBitmapConvForm.OpenButtonClick(Sender: TObject);
+var
+ x : TMufasaBitmap;
+begin
+ if OpenPictureDialog.Execute then
+ begin
+ try
+ ImagePreview.Picture.LoadFromFile(OpenPictureDialog.FileName);
+ GroupBox.Caption:= Format(BmpSizeTxt,[ImagePreview.Picture.Width,ImagePreview.Picture.Height]);
+ x := TMufasaBitmap.Create;
+ x.LoadFromFile(OpenPictureDialog.FileName);
+ if dispPic <> nil then
+ dispPic.Free;
+ dispPic := x;
+ except
+ formWritelnEx('ERROR loading the file: ' + OpenPictureDialog.FileName);
+ ImagePreview.Picture := nil;
+ if dispPic <> nil then
+ FreeAndNil(dispPic);
+ end;
+ end;
+end;
+
+procedure TBitmapConvForm.ToStringButtonClick(Sender: TObject);
+var
+ str : string;
+ strend : string;
+ len : integer;
+begin
+ if dispPic <> nil then
+ begin
+ str := ' Bmp := BitmapFromString('+
+ inttostr(disppic.Width)+ ', ' + inttostr(disppic.height) +', '#39 + dispPic.ToString;
+ strend := #39 +');';
+ len := length(str);
+ if PadOutput.Checked then
+ while Len > 65 do
+ begin
+ formWritelnEx(Copy(str,1,62) + #39 + ' +');
+ delete(str,1,62);
+ str := StringOfChar(' ',8) + #39 + str;
+ len := length(str);
+ end;
+ formWritelnEx(str + strend);
+ end;
+end;
+
+end.
+
diff --git a/Projects/SAMufasaGUI/colourhistory.lfm b/Projects/Simba/colourhistory.lfm
similarity index 100%
rename from Projects/SAMufasaGUI/colourhistory.lfm
rename to Projects/Simba/colourhistory.lfm
diff --git a/Projects/SAMufasaGUI/colourhistory.pas b/Projects/Simba/colourhistory.pas
similarity index 98%
rename from Projects/SAMufasaGUI/colourhistory.pas
rename to Projects/Simba/colourhistory.pas
index e7a741d..50f5361 100644
--- a/Projects/SAMufasaGUI/colourhistory.pas
+++ b/Projects/Simba/colourhistory.pas
@@ -104,7 +104,7 @@ var
implementation
uses
- colour_conv, TestUnit, lclintf, lcltype;
+ colour_conv, SimbaUnit, lclintf, lcltype;
constructor TColourPickerObject.Create(C: Integer; P: TPoint; N: String);
begin
@@ -502,7 +502,7 @@ constructor TColourHistoryForm.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
- PickNewColourButton.OnClick:= @Form1.ButtonPickClick;
+ PickNewColourButton.OnClick:= @SimbaForm.ButtonPickClick;
end;
destructor TColourHistoryForm.Destroy;
@@ -544,12 +544,12 @@ end;
procedure TColourHistoryForm.SetCHShowMenu(Sender: TObject);
begin
- Form1.MenuItemColourHistory.Checked := True;
+ SimbaForm.MenuItemColourHistory.Checked := True;
end;
procedure TColourHistoryForm.UnSetCHShowMenu(Sender: TObject);
begin
- Form1.MenuItemColourHistory.Checked := False;
+ SimbaForm.MenuItemColourHistory.Checked := False;
end;
initialization
diff --git a/Projects/SAMufasaGUI/debugimage.lfm b/Projects/Simba/debugimage.lfm
similarity index 82%
rename from Projects/SAMufasaGUI/debugimage.lfm
rename to Projects/Simba/debugimage.lfm
index cd75727..9fed3c4 100644
--- a/Projects/SAMufasaGUI/debugimage.lfm
+++ b/Projects/Simba/debugimage.lfm
@@ -1,15 +1,16 @@
object DebugImgForm: TDebugImgForm
- Left = 1335
+ Left = 393
Height = 300
- Top = 172
+ Top = 278
Width = 400
BorderIcons = [biSystemMenu, biMinimize]
- BorderStyle = bsSingle
+ BorderStyle = bsToolWindow
Caption = 'DebugImgForm'
ClientHeight = 300
ClientWidth = 400
OnCreate = FormCreate
OnHide = FormHide
+ Position = poMainFormCenter
LCLVersion = '0.9.29'
object DrawImage: TImage
Left = 0
diff --git a/Projects/SAMufasaGUI/debugimage.pas b/Projects/Simba/debugimage.pas
similarity index 95%
rename from Projects/SAMufasaGUI/debugimage.pas
rename to Projects/Simba/debugimage.pas
index ac3bfa8..53b8dca 100644
--- a/Projects/SAMufasaGUI/debugimage.pas
+++ b/Projects/Simba/debugimage.pas
@@ -59,7 +59,7 @@ var
implementation
uses
- MufasaTypes, math, graphtype, IntfGraphics,TestUnit,lclintf,colour_conv,InterfaceBase;
+ MufasaTypes, math, graphtype, IntfGraphics,SimbaUnit,lclintf,colour_conv,InterfaceBase;
{ TDebugImgForm }
procedure TDebugImgForm.FormCreate(Sender: TObject);
@@ -76,7 +76,7 @@ end;
procedure TDebugImgForm.FormHide(Sender: TObject);
begin
- Form1.MenuItemDebugImage.Checked := False;
+ SimbaForm.MenuItemDebugImage.Checked := False;
end;
procedure TDebugImgForm.BlackDebugImage;
diff --git a/Projects/SAMufasaGUI/extensionmanager.pas b/Projects/Simba/extensionmanager.pas
similarity index 98%
rename from Projects/SAMufasaGUI/extensionmanager.pas
rename to Projects/Simba/extensionmanager.pas
index 722da31..8727080 100644
--- a/Projects/SAMufasaGUI/extensionmanager.pas
+++ b/Projects/Simba/extensionmanager.pas
@@ -38,7 +38,7 @@ var
implementation
uses
- TestUnit, settingssandbox,simbasettings;
+ SimbaUnit, settingssandbox,Simbasettings;
procedure TExtensionManager.SetOnchange(const AValue: TNotifyEvent);
var
diff --git a/Projects/SAMufasaGUI/extensionmanagergui.lfm b/Projects/Simba/extensionmanagergui.lfm
similarity index 100%
rename from Projects/SAMufasaGUI/extensionmanagergui.lfm
rename to Projects/Simba/extensionmanagergui.lfm
diff --git a/Projects/SAMufasaGUI/extensionmanagergui.pas b/Projects/Simba/extensionmanagergui.pas
similarity index 100%
rename from Projects/SAMufasaGUI/extensionmanagergui.pas
rename to Projects/Simba/extensionmanagergui.pas
diff --git a/Projects/SAMufasaGUI/framefunctionlist.lfm b/Projects/Simba/framefunctionlist.lfm
similarity index 98%
rename from Projects/SAMufasaGUI/framefunctionlist.lfm
rename to Projects/Simba/framefunctionlist.lfm
index afd316d..c61f06a 100644
--- a/Projects/SAMufasaGUI/framefunctionlist.lfm
+++ b/Projects/Simba/framefunctionlist.lfm
@@ -12,11 +12,11 @@ object FunctionListFrame: TFunctionListFrame
DesignTop = 219
object FunctionList: TTreeView
Left = 0
- Height = 479
- Top = 20
+ Height = 483
+ Top = 18
Width = 182
Align = alClient
- DefaultItemHeight = 17
+ DefaultItemHeight = 15
ReadOnly = True
ScrollBars = ssAutoBoth
TabOrder = 0
@@ -28,8 +28,8 @@ object FunctionListFrame: TFunctionListFrame
end
object editSearchList: TEdit
Left = 0
- Height = 23
- Top = 499
+ Height = 21
+ Top = 501
Width = 182
Align = alBottom
OnChange = editSearchListChange
@@ -37,7 +37,7 @@ object FunctionListFrame: TFunctionListFrame
end
object FunctionListLabel: TLabel
Left = 2
- Height = 16
+ Height = 14
Top = 2
Width = 178
Align = alTop
diff --git a/Projects/SAMufasaGUI/framefunctionlist.pas b/Projects/Simba/framefunctionlist.pas
similarity index 89%
rename from Projects/SAMufasaGUI/framefunctionlist.pas
rename to Projects/Simba/framefunctionlist.pas
index a0fb571..a83f6d2 100644
--- a/Projects/SAMufasaGUI/framefunctionlist.pas
+++ b/Projects/Simba/framefunctionlist.pas
@@ -72,7 +72,7 @@ type
implementation
uses
- TestUnit, Graphics, stringutil, simpleanalyzer,v_ideCodeParser,lclintf;
+ SimbaUnit, Graphics, stringutil, simpleanalyzer,v_ideCodeParser,lclintf;
{ TFunctionListFrame }
@@ -99,14 +99,14 @@ procedure TFunctionListFrame.FrameEndDock(Sender, Target: TObject; X, Y: Integer
begin
if Target is TPanel then
begin
- Form1.SplitterFunctionList.Visible := true;
+ SimbaForm.SplitterFunctionList.Visible := true;
CloseButton.Visible:= true;
end
else if Target is TCustomDockForm then
begin
TCustomDockForm(Target).Caption := 'Functionlist';
TCustomDockForm(Target).OnClose := @DockFormOnClose;
- Form1.SplitterFunctionList.Visible:= false;
+ SimbaForm.SplitterFunctionList.Visible:= false;
CloseButton.Visible:= false;
end;
end;
@@ -125,8 +125,8 @@ begin
if node.Data <> nil then
if InCodeCompletion then
begin
- Form1.CurrScript.SynEdit.InsertTextAtCaret( GetMethodName(PMethodInfo(node.Data)^.MethodStr,true));
- Form1.RefreshTab;
+ SimbaForm.CurrScript.SynEdit.InsertTextAtCaret( GetMethodName(PMethodInfo(node.Data)^.MethodStr,true));
+ SimbaForm.RefreshTab;
end
else
begin
@@ -138,10 +138,10 @@ begin
if MethodInfo.Filename <> '' then
begin;
// Writeln(MethodInfo.filename);
- Form1.LoadScriptFile(MethodInfo.Filename,true,true);
+ SimbaForm.LoadScriptFile(MethodInfo.Filename,true,true);
end;
- Form1.CurrScript.SynEdit.SelStart := MethodInfo.BeginPos + 1;
- Form1.CurrScript.SynEdit.SelEnd := MethodInfo.EndPos + 1;
+ SimbaForm.CurrScript.SynEdit.SelStart := MethodInfo.BeginPos + 1;
+ SimbaForm.CurrScript.SynEdit.SelEnd := MethodInfo.EndPos + 1;
end;
end;
end;
@@ -172,13 +172,13 @@ end;
procedure TFunctionListFrame.DockFormOnClose(Sender: TObject; var CloseAction: TCloseAction);
begin
CloseAction := caHide;
- Form1.MenuItemFunctionList.Checked := False;
+ SimbaForm.MenuItemFunctionList.Checked := False;
end;
procedure TFunctionListFrame.CloseButtonClick(Sender: TObject);
begin
self.Hide;
- Form1.MenuItemFunctionList.Checked := False;
+ SimbaForm.MenuItemFunctionList.Checked := False;
end;
procedure TFunctionListFrame.FunctionListMouseUp(Sender: TObject;
@@ -248,8 +248,8 @@ begin
FillThread.Analyzer := TCodeInsight.Create;
with FillThread,FillThread.Analyzer do
begin
- OnFindInclude := @Form1.OnCCFindInclude;
- FileName := Form1.CurrScript.ScriptFile;
+ OnFindInclude := @SimbaForm.OnCCFindInclude;
+ FileName := SimbaForm.CurrScript.ScriptFile;
MS := TMemoryStream.Create;
MS.Write(Script[1],length(script));
OnTerminate:=@FillThreadTerminate;
@@ -278,9 +278,9 @@ begin
FunctionList.FullCollapse;
if InCodeCompletion then
begin;
- Form1.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart;
- Form1.CurrScript.SynEdit.LogicalCaretXY:= point(CompletionCaret.x,CompletionCaret.y);
- Form1.CurrScript.SynEdit.SelEnd:= Form1.CurrScript.SynEdit.SelStart;
+ SimbaForm.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart;
+ SimbaForm.CurrScript.SynEdit.LogicalCaretXY:= point(CompletionCaret.x,CompletionCaret.y);
+ SimbaForm.CurrScript.SynEdit.SelEnd:= SimbaForm.CurrScript.SynEdit.SelStart;
end;
FilterTreeVis(False);
ScriptNode.Expand(true);
@@ -403,7 +403,7 @@ begin
FilterTreeVis(false);
editSearchList.Color := 6711039;
if InCodeCompletion then
- Form1.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart;
+ SimbaForm.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart;
end;
FilterTree.EndUpdate;
end;
@@ -411,7 +411,7 @@ begin
if result and InCodeCompletion then
begin;
str := format(CompletionLine, [InsertStr]);
- with Form1.CurrScript.SynEdit do
+ with SimbaForm.CurrScript.SynEdit do
begin;
Lines[CompletionCaret.y - 1] := str;
LogicalCaretXY:= StartWordCompletion;
@@ -474,20 +474,21 @@ procedure TFillThread.execute;
if procs = nil then
exit;
for i := 0 to Procs.Count - 1 do
- if (Procs[i] is TciProcedureDeclaration) then
+ if (Procs[i] <> nil) and (Procs[i] is TciProcedureDeclaration) then
with Procs[i] as TciProcedureDeclaration do
- begin
- tmpNode := FunctionList^.Items.AddChild(Node,name.ShortText);
- tmpNode.Data := GetMem(SizeOf(TMethodInfo));
- FillChar(PMethodInfo(tmpNode.Data)^,SizeOf(TMethodInfo),0);
- with PMethodInfo(tmpNode.Data)^ do
+ if name <> nil then
begin
- MethodStr := strnew(Pchar(CleanDeclaration));
- Filename:= strnew(pchar(path));
- BeginPos:= name.StartPos ;
- EndPos := name.StartPos + Length(TrimRight(name.RawText));
+ tmpNode := FunctionList^.Items.AddChild(Node,name.ShortText);
+ tmpNode.Data := GetMem(SizeOf(TMethodInfo));
+ FillChar(PMethodInfo(tmpNode.Data)^,SizeOf(TMethodInfo),0);
+ with PMethodInfo(tmpNode.Data)^ do
+ begin
+ MethodStr := strnew(Pchar(CleanDeclaration));
+ Filename:= strnew(pchar(path));
+ BeginPos:= name.StartPos ;
+ EndPos := name.StartPos + Length(TrimRight(name.RawText));
+ end;
end;
- end;
end;
procedure AddIncludes(ParentNode : TTreeNode; Include : TCodeInsight);
diff --git a/Projects/SAMufasaGUI/framescript.lfm b/Projects/Simba/framescript.lfm
similarity index 99%
rename from Projects/SAMufasaGUI/framescript.lfm
rename to Projects/Simba/framescript.lfm
index f0ad4a6..5754b6d 100644
--- a/Projects/SAMufasaGUI/framescript.lfm
+++ b/Projects/Simba/framescript.lfm
@@ -20,7 +20,7 @@ object ScriptFrame: TScriptFrame
Font.Quality = fqNonAntialiased
ParentColor = False
ParentFont = False
- PopupMenu = Form1.ScriptPopup
+ PopupMenu = SimbaForm.ScriptPopup
TabOrder = 0
OnDragDrop = SynEditDragDrop
OnDragOver = SynEditDragOver
diff --git a/Projects/SAMufasaGUI/framescript.pas b/Projects/Simba/framescript.pas
similarity index 86%
rename from Projects/SAMufasaGUI/framescript.pas
rename to Projects/Simba/framescript.pas
index 70e19b0..07c7450 100644
--- a/Projects/SAMufasaGUI/framescript.pas
+++ b/Projects/Simba/framescript.pas
@@ -85,7 +85,6 @@ type
procedure MakeActiveScriptFrame;
procedure ScriptThreadTerminate(Sender: TObject);
constructor Create(TheOwner: TComponent); override;
- destructor Destroy; override;
{ public declarations }
end;
@@ -93,7 +92,7 @@ type
implementation
uses
- TestUnit, SynEditTypes, LCLIntF, StrUtils,framefunctionlist;
+ SimbaUnit, SynEditTypes, LCLIntF, StrUtils,framefunctionlist;
function WordAtCaret(e: TSynEdit; var sp, ep: Integer; Start: Integer = -1): string;
var
@@ -156,7 +155,7 @@ begin
if not ScriptChanged then
begin;
ScriptChanged:= True;
- Form1.Caption:= Format(WindowTitle,[ScriptName + '*']);
+ SimbaForm.Caption:= Format(WindowTitle,[ScriptName + '*']);
OwnerSheet.Caption:=ScriptName + '*';
end;
end;
@@ -172,8 +171,8 @@ var
begin
mp := TCodeInsight.Create;
mp.FileName := ScriptFile;
- mp.OnMessage := @Form1.OnCCMessage;
- mp.OnFindInclude := @Form1.OnCCFindInclude;
+ mp.OnMessage := @SimbaForm.OnCCMessage;
+ mp.OnFindInclude := @SimbaForm.OnCCFindInclude;
ms := TMemoryStream.Create;
SynEdit.Lines.SaveToStream(ms);
@@ -194,10 +193,10 @@ begin
begin
if FileExists(TCodeInsight(d.Parser).FileName) then
begin;
- if Form1.LoadScriptFile(TCodeInsight(d.Parser).FileName,true,true) then
+ if SimbaForm.LoadScriptFile(TCodeInsight(d.Parser).FileName,true,true) then
begin;
- Form1.CurrScript.SynEdit.SelStart:= d.StartPos + 1;
- Form1.CurrScript.SynEdit.SelEnd := d.StartPos + Length(TrimRight(d.RawText)) + 1;
+ SimbaForm.CurrScript.SynEdit.SelStart:= d.StartPos + 1;
+ SimbaForm.CurrScript.SynEdit.SelEnd := d.StartPos + Length(TrimRight(d.RawText)) + 1;
end;
end
else
@@ -220,7 +219,7 @@ procedure TScriptFrame.SynEditCommandProcessed(Sender: TObject;
var
Command2 : TSynEditorCommand;
begin
- if (Command = ecChar) and (AChar = '(') and (Form1.ParamHint.Visible = false) and (Form1.ShowHintAuto) then
+ if (Command = ecChar) and (AChar = '(') and (SimbaForm.ParamHint.Visible = false) and (SimbaForm.ShowHintAuto) then
begin
Command2:= ecCodeHints;
SynEditProcessUserCommand(sender,command2,achar,nil);
@@ -237,12 +236,12 @@ end;
procedure TScriptFrame.SynEditDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
- Accept := Source = Form1.frmFunctionList;
+ Accept := Source = SimbaForm.frmFunctionList;
if(Accept)then
begin
SynEdit.CaretXY := SynEdit.PixelsToLogicalPos(point(x, y));
- if(not(Form1.Active))then Form1.BringToFront;
- if(Form1.ActiveControl <> SynEdit)then Form1.ActiveControl := SynEdit;
+ if(not(SimbaForm.Active))then SimbaForm.BringToFront;
+ if(SimbaForm.ActiveControl <> SynEdit)then SimbaForm.ActiveControl := SynEdit;
end;
end;
@@ -251,18 +250,18 @@ procedure TScriptFrame.SynEditKeyDown(Sender: TObject; var Key: Word;
begin
if key = VK_F3 then
begin;
- Form1.ActionFindNextExecute(Sender);
+ SimbaForm.ActionFindNextExecute(Sender);
key := 0;
end;
if key = VK_ESCAPE then
- Form1.ParamHint.Hide;
+ SimbaForm.ParamHint.Hide;
- Form1.CodeCompletionForm.HandleKeyDown(Sender, Key, Shift);
+ SimbaForm.CodeCompletionForm.HandleKeyDown(Sender, Key, Shift);
end;
procedure TScriptFrame.SynEditKeyPress(Sender: TObject; var Key: char);
begin
- Form1.CodeCompletionForm.HandleKeyPress(Sender, Key);
+ SimbaForm.CodeCompletionForm.HandleKeyPress(Sender, Key);
end;
procedure TScriptFrame.SynEditMouseLink(Sender: TObject; X, Y: Integer;
@@ -309,8 +308,8 @@ begin
if (Command = ecCodeCompletion) and ((not SynEdit.GetHighlighterAttriAtRowCol(SynEdit.CaretXY, s, Attri)) or
((Attri.Name <> SYNS_AttrComment) and (Attri.name <> SYNS_AttrString) and (Attri.name <> SYNS_AttrDirective))) then
begin
- {form1.FunctionListShown(True);
- with form1.frmFunctionList do
+ {SimbaForm.FunctionListShown(True);
+ with SimbaForm.frmFunctionList do
if editSearchList.CanFocus then
begin;
editSearchList.SetFocus;
@@ -348,8 +347,8 @@ begin
end;}
mp := TCodeInsight.Create;
mp.FileName := ScriptFile;
- mp.OnMessage := @Form1.OnCCMessage;
- mp.OnFindInclude := @Form1.OnCCFindInclude;
+ mp.OnMessage := @SimbaForm.OnCCMessage;
+ mp.OnFindInclude := @SimbaForm.OnCCFindInclude;
ms := TMemoryStream.Create;
ItemList := TStringList.Create;
@@ -360,7 +359,7 @@ begin
try
Filter := WordAtCaret(Synedit, sp, ep);
- Form1.CodeCompletionStart := Point(sp, Synedit.CaretY);
+ SimbaForm.CodeCompletionStart := Point(sp, Synedit.CaretY);
//mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1);
s := SynEdit.Lines[SynEdit.Carety-1];
@@ -382,7 +381,7 @@ begin
mp.FillSynCompletionProposal(ItemList, InsertList, s);
p := SynEdit.ClientToScreen(SynEdit.RowColumnToPixels(Point(ep, SynEdit.CaretY)));
p.y := p.y + SynEdit.LineHeight;
- Form1.CodeCompletionForm.Show(p, ItemList, InsertList, Filter, SynEdit);
+ SimbaForm.CodeCompletionForm.Show(p, ItemList, InsertList, Filter, SynEdit);
finally
FreeAndNil(ms);
FreeAndNil(mp);
@@ -392,11 +391,11 @@ begin
end;
if command = ecCodeHints then
begin
- if Form1.ParamHint.Visible = true then
- form1.ParamHint.hide;
+ if SimbaForm.ParamHint.Visible = true then
+ SimbaForm.ParamHint.hide;
mp := TCodeInsight.Create;
- mp.OnMessage := @form1.OnCCMessage;
- mp.OnFindInclude := @form1.OnCCFindInclude;
+ mp.OnMessage := @SimbaForm.OnCCMessage;
+ mp.OnFindInclude := @SimbaForm.OnCCFindInclude;
ms := TMemoryStream.Create;
synedit.Lines.SaveToStream(ms);
@@ -441,7 +440,7 @@ begin
if (not (d is TciProcedureDeclaration)) and (d.Owner is TciProcedureDeclaration) then
d := d.Owner;
if (TciProcedureDeclaration(d).Params <> '') then
- Form1.ParamHint.Show(PosToCaretXY(synedit,posi + 1), PosToCaretXY(synedit,bracketpos),
+ SimbaForm.ParamHint.Show(PosToCaretXY(synedit,posi + 1), PosToCaretXY(synedit,bracketpos),
TciProcedureDeclaration(d), synedit,mp)
else
FormWriteln('');
@@ -452,21 +451,21 @@ begin
//Do not free the MP, we need to use this.
end;
end;
- if Form1.CodeCompletionForm.Visible then
+ if SimbaForm.CodeCompletionForm.Visible then
case Command of
ecDeleteChar, ecDeleteWord, ecDeleteEOL:
begin
- if (SynEdit.CaretY = Form1.CodeCompletionStart.y) then
+ if (SynEdit.CaretY = SimbaForm.CodeCompletionStart.y) then
begin
//e.GetWordBoundsAtRowCol(acp_start, sp, ep);
- s := WordAtCaret(SynEdit, sp, ep, Form1.CodeCompletionStart.x);
- if (SynEdit.CaretX >= Form1.CodeCompletionStart.x) and (SynEdit.CaretX <= ep) then
+ s := WordAtCaret(SynEdit, sp, ep, SimbaForm.CodeCompletionStart.x);
+ if (SynEdit.CaretX >= SimbaForm.CodeCompletionStart.x) and (SynEdit.CaretX <= ep) then
begin
- Form1.CodeCompletionForm.ListBox.Filter := s;
+ SimbaForm.CodeCompletionForm.ListBox.Filter := s;
Exit;
end;
end;
- Form1.CodeCompletionForm.Hide;
+ SimbaForm.CodeCompletionForm.Hide;
end;
end;
end;
@@ -491,28 +490,28 @@ begin
{$IFDEF UpdateEditButtons}
if scSelection in changes then
begin;
- Form1.TT_Cut.Enabled := SynEdit.SelAvail;
- form1.TT_Copy.Enabled:= Form1.TT_Cut.Enabled;
- form1.TT_Paste.Enabled:= SynEdit.CanPaste;
+ SimbaForm.TT_Cut.Enabled := SynEdit.SelAvail;
+ SimbaForm.TT_Copy.Enabled:= SimbaForm.TT_Cut.Enabled;
+ SimbaForm.TT_Paste.Enabled:= SynEdit.CanPaste;
end;
{$ENDIF}
- if Form1.CodeCompletionForm.Visible then
+ if SimbaForm.CodeCompletionForm.Visible then
if (scAll in Changes) or (scTopLine in Changes) then
- Form1.CodeCompletionForm.Visible := False
+ SimbaForm.CodeCompletionForm.Visible := False
else if (scCaretX in Changes) or (scCaretY in Changes) or (scSelection in Changes) or (scModified in Changes) then
begin
- if (SynEdit.CaretY = Form1.CodeCompletionStart.y) then
+ if (SynEdit.CaretY = SimbaForm.CodeCompletionStart.y) then
begin
- s := WordAtCaret(SynEdit, sp, ep, Form1.CodeCompletionStart.x);
- if (SynEdit.CaretX >= Form1.CodeCompletionStart.x) and (SynEdit.CaretX - 1 <= ep) then
+ s := WordAtCaret(SynEdit, sp, ep, SimbaForm.CodeCompletionStart.x);
+ if (SynEdit.CaretX >= SimbaForm.CodeCompletionStart.x) and (SynEdit.CaretX - 1 <= ep) then
begin
- Form1.CodeCompletionForm.ListBox.Filter := s;
+ SimbaForm.CodeCompletionForm.ListBox.Filter := s;
Exit;
end;
end;
- Form1.CodeCompletionForm.Hide;
+ SimbaForm.CodeCompletionForm.Hide;
end;
end;
@@ -522,7 +521,7 @@ begin
if ScriptChanged then
if SynEdit.Lines.Text = StartText then
begin;
- Form1.Caption:= format(WindowTitle,[ScriptName]);
+ SimbaForm.Caption:= format(WindowTitle,[ScriptName]);
OwnerSheet.Caption:= ScriptName;
ScriptChanged := false;
end;
@@ -534,7 +533,7 @@ begin
if ScriptChanged then
if SynEdit.Lines.Text = StartText then
begin;
- Form1.Caption:= format(WindowTitle,[ScriptName]);
+ SimbaForm.Caption:= format(WindowTitle,[ScriptName]);
OwnerSheet.Caption := ScriptName;
ScriptChanged := false;
end;
@@ -551,10 +550,10 @@ begin
else
begin
ErrorData.Module:= SetDirSeparators(ErrorData.Module);// Set it right ;-)
- Form1.LoadScriptFile(ErrorData.Module,true,true);//Checks if the file is already open!
+ SimbaForm.LoadScriptFile(ErrorData.Module,true,true);//Checks if the file is already open!
ErrorData.Module:= '';
- Form1.CurrScript.ErrorData := Self.ErrorData;
- Form1.CurrScript.HandleErrorData;
+ SimbaForm.CurrScript.ErrorData := Self.ErrorData;
+ SimbaForm.CurrScript.HandleErrorData;
exit;
end;
end;
@@ -575,7 +574,7 @@ procedure TScriptFrame.MakeActiveScriptFrame;
var
i : integer;
begin
- if Form1.Visible then
+ if SimbaForm.Visible then
for i := 0 to OwnerPage.PageCount - 1 do
if OwnerPage.Pages[i] = OwnerSheet then
begin;
@@ -589,7 +588,7 @@ end;
procedure TScriptFrame.ScriptThreadTerminate(Sender: TObject);
begin
FScriptState:= ss_None;
- Form1.RefreshTab;
+ SimbaForm.RefreshTab;
end;
procedure AddKey(const SynEdit : TSynEdit; const ACmd: TSynEditorCommand; const AKey: word;const AShift: TShiftState);
begin
@@ -614,7 +613,7 @@ begin
FScriptState:= ss_None;
ScriptErrorLine:= -1;
OwnerSheet.Caption:= ScriptName;
- SynEdit.Highlighter := Form1.CurrHighlighter;
+ SynEdit.Highlighter := SimbaForm.CurrHighlighter;
SynEdit.Options:= SynEdit.Options + [eoTabIndent] - [eoSmartTabs];
SynEdit.IncrementColor.Background := $30D070;
SynEdit.HighlightAllColor.Background:= clYellow;
@@ -640,11 +639,6 @@ begin
// TSynPasSyn(SynEdit.Highlighter).NestedComments:= false; Does not work :(
end;
-destructor TScriptFrame.Destroy;
-begin
- inherited Destroy;
-end;
-
initialization
{$R *.lfm}
diff --git a/Projects/SAMufasaGUI/psextension.pas b/Projects/Simba/psextension.pas
similarity index 94%
rename from Projects/SAMufasaGUI/psextension.pas
rename to Projects/Simba/psextension.pas
index f1d84fa..f6418ec 100644
--- a/Projects/SAMufasaGUI/psextension.pas
+++ b/Projects/Simba/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,files,Dialogs, mmisc//Writeln
+ SimbaUnit,updateform,settingssandbox,bitmaps,files,Dialogs, mmisc//Writeln
;
function TSimbaPSExtension.HookExists(const HookName: String): Boolean;
@@ -119,10 +119,10 @@ procedure TSimbaPSExtension.RegisterMyMethods(Sender: TPSScript);
begin
Sender.Comp.AddTypes('TStringArray','Array of String');
Sender.Comp.AddConstantN('AppPath','string').SetString(MainDir + DirectorySeparator);
- Sender.Comp.AddConstantN('IncludePath','string').SetString(Form1.IncludePath);
- 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.AddConstantN('IncludePath','string').SetString(SimbaForm.IncludePath);
+ Sender.Comp.AddConstantN('PluginPath','string').SetString(SimbaForm.PluginPath);
+ Sender.Comp.AddConstantN('FontPath','string').SetString(SimbaForm.FontPath);
+ Sender.Comp.AddConstantN('ExtPath','string').SetString(SimbaForm.ExtPath);
Sender.Comp.AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmati'
+'on, mtCustom )');
Sender.Comp.AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, m'
@@ -146,8 +146,8 @@ end;
procedure TSimbaPSExtension.OnPSExecute(Sender: TPSScript);
begin
- Sender.SetVarToInstance('simba',Form1);
- Sender.SetVarToInstance('Simba_MainMenu',Form1.MainMenu);
+ Sender.SetVarToInstance('Simba',SimbaForm);
+ Sender.SetVarToInstance('Simba_MainMenu',SimbaForm.MainMenu);
Sender.SetPointerToData('Settings',@Self.Settings,Sender.FindNamedType('TMMLSettingsSandbox'));
end;
diff --git a/Projects/SAMufasaGUI/simbasettings.lfm b/Projects/Simba/simbasettings.lfm
similarity index 100%
rename from Projects/SAMufasaGUI/simbasettings.lfm
rename to Projects/Simba/simbasettings.lfm
diff --git a/Projects/SAMufasaGUI/simbasettings.pas b/Projects/Simba/simbasettings.pas
similarity index 99%
rename from Projects/SAMufasaGUI/simbasettings.pas
rename to Projects/Simba/simbasettings.pas
index bc5cb89..870e672 100644
--- a/Projects/SAMufasaGUI/simbasettings.pas
+++ b/Projects/Simba/simbasettings.pas
@@ -1,4 +1,4 @@
-unit simbasettings;
+unit Simbasettings;
{$mode objfpc}{$H+}
diff --git a/Projects/SAMufasaGUI/testunit.lfm b/Projects/Simba/simbaunit.lfm
similarity index 99%
rename from Projects/SAMufasaGUI/testunit.lfm
rename to Projects/Simba/simbaunit.lfm
index 97a5162..d207d31 100644
--- a/Projects/SAMufasaGUI/testunit.lfm
+++ b/Projects/Simba/simbaunit.lfm
@@ -1,10 +1,10 @@
-object Form1: TForm1
- Left = 150
+object SimbaForm: TSimbaForm
+ Left = 143
Height = 623
- Top = 69
+ Top = 115
Width = 660
AllowDropFiles = True
- Caption = 'THA FUKING SIMBA'
+ Caption = 'THA FUKING Simba'
ClientHeight = 603
ClientWidth = 660
KeyPreview = True
@@ -437,15 +437,12 @@ object Form1: TForm1
TabOrder = 3
inherited FunctionList: TTreeView
Height = 323
- Top = 18
Width = 150
- DefaultItemHeight = 15
OnChange = FunctionListChange
OnEnter = FunctionListEnter
OnExit = FunctionListExit
end
inherited editSearchList: TEdit
- Height = 21
Top = 341
Width = 150
OnExit = editSearchListExit
@@ -453,7 +450,6 @@ object Form1: TForm1
OnKeyPress = editSearchListKeyPress
end
inherited FunctionListLabel: TLabel
- Height = 14
Width = 146
end
end
@@ -802,6 +798,7 @@ object Form1: TForm1
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF006D9CD4896A9AD2FB6697CFEE
}
+ ShortCut = 16465
OnClick = ActionExitExecute
end
end
@@ -1352,6 +1349,10 @@ object Form1: TForm1
Caption = 'Settings'
OnClick = MenuItemSettingsButtonClick
end
+ object MenuItemBitmapConv: TMenuItem
+ Caption = '&Bitmap conversion'
+ OnClick = MenuItemBitmapConvClick
+ end
object MenuItemDivider10: TMenuItem
Caption = '-'
end
diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/Simba/simbaunit.pas
similarity index 87%
rename from Projects/SAMufasaGUI/testunit.pas
rename to Projects/Simba/simbaunit.pas
index 3d0ad7d..25992a3 100644
--- a/Projects/SAMufasaGUI/testunit.pas
+++ b/Projects/Simba/simbaunit.pas
@@ -18,10 +18,10 @@
See the file COPYING, included in this distribution,
for details about the copyright.
- TestUnit/GUI for the Mufasa Macro Library
+ Simba/GUI for the Mufasa Macro Library
}
-unit TestUnit;
+unit SimbaUnit;
{$undef EditButtons}
{$Undef ProcessMessages} //Define this for processmessages in ThreadSafeCall
@@ -41,12 +41,12 @@ uses
SynExportHTML, SynEditKeyCmds, SynEditHighlighter,
SynEditMarkupHighAll, LMessages, Buttons,mmisc,
stringutil,mufasatypesutil,mufasabase, v_ideCodeParser,
- about, framefunctionlist, ocr, updateform, simbasettings, psextension, virtualextension,
+ about, framefunctionlist, ocr, updateform, Simbasettings, psextension, virtualextension,
extensionmanager, settingssandbox, v_ideCodeInsight, CastaliaPasLexTypes,
CastaliaSimplePasPar, v_AutoCompleteForm, PSDump;
const
- SimbaVersion = 650;
+ SimbaVersion = 668;
type
@@ -64,9 +64,9 @@ type
end;
// Tab
- { TForm1 }
+ { TSimbaForm }
- TForm1 = class(TForm)
+ TSimbaForm = class(TForm)
ActionConsole: TAction;
ActionNormalSize: TAction;
ActionCompileScript: TAction;
@@ -104,6 +104,7 @@ type
MenuFile: TMenuItem;
MenuEdit: TMenuItem;
MenuHelp: TMenuItem;
+ MenuItemBitmapConv: TMenuItem;
MenuItemExtensions: TMenuItem;
MenuItemSettingsButton: TMenuItem;
MenuItemDivider10: TMenuItem;
@@ -258,6 +259,7 @@ type
procedure FunctionListEnter(Sender: TObject);
procedure FunctionListExit(Sender: TObject);
procedure FunctionListTimerTimer(Sender: TObject);
+ procedure MenuItemBitmapConvClick(Sender: TObject);
procedure MenuItemExtensionsClick(Sender: TObject);
procedure MenuItemHandbookClick(Sender: TObject);
procedure MenuItemColourHistoryClick(Sender: TObject);
@@ -445,7 +447,7 @@ const
Image_Stop = 7;
Image_Terminate = 19;
var
- Form1: TForm1;
+ SimbaForm: TSimbaForm;
MainDir : string;
{$ifdef MSWindows}
PrevWndProc : WNDPROC;
@@ -459,6 +461,7 @@ uses
debugimage,
files,
InterfaceBase,
+ bitmapconv,
extensionmanagergui,
colourhistory,
math;
@@ -466,7 +469,7 @@ uses
{$ifdef mswindows}
function ConsoleHandler( eventType : DWord) : WINBOOL;stdcall;
begin
- TThread.Synchronize(nil,@Form1.Close);
+ TThread.Synchronize(nil,@SimbaForm.Close);
Result := true;
end;
@@ -476,7 +479,7 @@ function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam;
begin
if uMsg = WM_HOTKEY then
begin
- Form1.ActionStopScript.Execute;
+ SimbaForm.ActionStopScript.Execute;
Result := 0;
end else
Result := Windows.CallWindowProc(PrevWndProc,Ahwnd, uMsg, WParam, LParam);
@@ -487,7 +490,7 @@ end;
var
DebugCriticalSection: syncobjs.TCriticalSection;
-procedure TForm1.OnCCMessage(Sender: TObject; const Typ: TMessageEventType; const Msg: string; X, Y: Integer);
+procedure TSimbaForm.OnCCMessage(Sender: TObject; const Typ: TMessageEventType; const Msg: string; X, Y: Integer);
begin
if (Typ = meNotSupported) then
Exit;
@@ -497,7 +500,7 @@ begin
mDebugLn('ERROR: '+Format('%d:%d %s', [Y + 1, X, Msg])+' in '+TCodeInsight(Sender).FileName);
end;
-procedure TForm1.OnCompleteCode(Str: string);
+procedure TSimbaForm.OnCompleteCode(Str: string);
var
sp, ep: Integer;
s: string;
@@ -516,7 +519,7 @@ begin
end;
end;
-function TForm1.OnCCFindInclude(Sender: TObject; var FileName: string): Boolean;
+function TSimbaForm.OnCCFindInclude(Sender: TObject; var FileName: string): Boolean;
var
Temp : string;
begin
@@ -529,7 +532,7 @@ begin
result := false;
end;
-procedure TForm1.HandleConnectionData;
+procedure TSimbaForm.HandleConnectionData;
var
Args : TVariantArray;
begin
@@ -546,12 +549,12 @@ begin
end;
end;
-function TForm1.GetScriptPath: string;
+function TSimbaForm.GetScriptPath: string;
begin
result :=IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Scripts/Path', ExpandFileName(MainDir+DS+'Scripts' + DS)));
end;
-procedure TForm1.HandleOpenFileData;
+procedure TSimbaForm.HandleOpenFileData;
var
Args : TVariantArray;
begin
@@ -568,7 +571,7 @@ begin
end;
end;
-procedure TForm1.HandleWriteFileData;
+procedure TSimbaForm.HandleWriteFileData;
var
Args : TVariantArray;
begin
@@ -585,7 +588,7 @@ begin
end;
end;
-procedure TForm1.HandleScriptStartData;
+procedure TSimbaForm.HandleScriptStartData;
var
Args : TVariantArray;
begin
@@ -602,7 +605,7 @@ begin
end;
end;
-procedure TForm1.ProcessDebugStream(Sender: TObject);
+procedure TSimbaForm.ProcessDebugStream(Sender: TObject);
begin
if length(DebugStream) = 0 then
Exit;
@@ -620,7 +623,7 @@ begin
end;
end;
-procedure TForm1.RecentFileItemsClick(Sender: TObject);
+procedure TSimbaForm.RecentFileItemsClick(Sender: TObject);
var
i : integer;
begin
@@ -632,7 +635,7 @@ begin
end;
end;
-procedure TForm1.ScriptPanelDockDrop(Sender: TObject; Source: TDragDockObject;
+procedure TSimbaForm.ScriptPanelDockDrop(Sender: TObject; Source: TDragDockObject;
X, Y: Integer);
begin
if(X <= (ScriptPanel.Width div 2))then
@@ -655,7 +658,7 @@ begin
SplitterFunctionList.Show;
end;
-procedure TForm1.ScriptPanelDockOver(Sender: TObject; Source: TDragDockObject; //is there a better way to do all of this?
+procedure TSimbaForm.ScriptPanelDockOver(Sender: TObject; Source: TDragDockObject; //is there a better way to do all of this?
X, Y: Integer; State: TDragState; var Accept: Boolean);
var
P: TPoint;
@@ -671,29 +674,29 @@ begin
end;
end;
-procedure TForm1.ScriptPopupPopup(Sender: TObject);
+procedure TSimbaForm.ScriptPopupPopup(Sender: TObject);
begin
SetEditActions;
end;
-procedure TForm1.SpeedButtonSearchClick(Sender: TObject);
+procedure TSimbaForm.SpeedButtonSearchClick(Sender: TObject);
begin
CloseFindPanel;
end;
-procedure TForm1.SplitterFunctionListCanResize(Sender: TObject; var NewSize: Integer;
+procedure TSimbaForm.SplitterFunctionListCanResize(Sender: TObject; var NewSize: Integer;
var Accept: Boolean);
begin
if(NewSize > ScriptPanel.Width div 2)then
NewSize := ScriptPanel.Width div 2;
end;
-procedure TForm1.TB_ReloadPluginsClick(Sender: TObject);
+procedure TSimbaForm.TB_ReloadPluginsClick(Sender: TObject);
begin
// PluginsGlob.FreePlugins;
end;
-procedure TForm1.ThreadOpenConnectionEvent(Sender: TObject; var url: string;var Continue: boolean);
+procedure TSimbaForm.ThreadOpenConnectionEvent(Sender: TObject; var url: string;var Continue: boolean);
begin
OpenConnectionData.Sender := Sender;
OpenConnectionData.URL:= @URL;
@@ -701,7 +704,7 @@ begin
TThread.Synchronize(nil,@HandleConnectionData);
end;
-procedure TForm1.ThreadOpenFileEvent(Sender: TObject; var Filename: string;
+procedure TSimbaForm.ThreadOpenFileEvent(Sender: TObject; var Filename: string;
var Continue: boolean);
begin
OpenFileData.Sender := Sender;
@@ -710,7 +713,7 @@ begin
TThread.Synchronize(nil,@HandleOpenFileData);
end;
-procedure TForm1.ThreadWriteFileEvent(Sender: TObject; var Filename: string;
+procedure TSimbaForm.ThreadWriteFileEvent(Sender: TObject; var Filename: string;
var Continue: boolean);
begin
WriteFileData.Sender := Sender;
@@ -719,24 +722,24 @@ begin
TThread.Synchronize(nil,@HandleWriteFileData);
end;
-procedure TForm1.TrayPopupPopup(Sender: TObject);
+procedure TSimbaForm.TrayPopupPopup(Sender: TObject);
begin
- MenuItemHide.enabled:= Form1.Visible;
+ MenuItemHide.enabled:= SimbaForm.Visible;
{$ifdef MSWindows}
- MenuItemShow.Enabled:= not Form1.Visible;
- if Form1.Visible then
- if Form1.CanFocus then
- form1.SetFocus;
+ MenuItemShow.Enabled:= not SimbaForm.Visible;
+ if SimbaForm.Visible then
+ if SimbaForm.CanFocus then
+ SimbaForm.SetFocus;
{$endif}
end;
-procedure TForm1.TT_UpdateClick(Sender: TObject);
+procedure TSimbaForm.TT_UpdateClick(Sender: TObject);
begin
SimbaUpdateForm.ShowModal;
TT_Update.Visible:=False;
end;
-procedure TForm1.UpdateTimerCheck(Sender: TObject);
+procedure TSimbaForm.UpdateTimerCheck(Sender: TObject);
var
chk: String;
time:integer;
@@ -764,7 +767,7 @@ begin
UpdateTimer.Interval:= time {mins} * 60 {secs} * 1000 {ms};//Every half hour
end;
-procedure TForm1.UpdateMenuButtonClick(Sender: TObject);
+procedure TSimbaForm.UpdateMenuButtonClick(Sender: TObject);
begin
SimbaUpdateForm.ShowModal;
end;
@@ -772,9 +775,9 @@ end;
procedure ClearDebug;
begin
{$IFNDEF MSWINDOWS}
- Form1.ProcessDebugStream(nil);
+ SimbaForm.ProcessDebugStream(nil);
{$ENDIF}
- TThread.Synchronize(nil,@Form1.Memo1.Clear);
+ TThread.Synchronize(nil,@SimbaForm.Memo1.Clear);
end;
procedure formWriteln( S : String);
@@ -782,12 +785,12 @@ begin
mDebugLn('formWriteln: ' + s);
{$ifdef MSWindows}
//Ha, we cán acces the debugmemo
- Form1.Memo1.Lines.Add(s);
+ SimbaForm.Memo1.Lines.Add(s);
{$else}
DebugCriticalSection.Enter;
try
s := s + MEOL;
- Form1.DebugStream:= Form1.DebugStream + s;
+ SimbaForm.DebugStream:= SimbaForm.DebugStream + s;
finally
DebugCriticalSection.Leave;
end;
@@ -796,7 +799,7 @@ end;
//{$ENDIF}
-procedure TForm1.RunScript;
+procedure TSimbaForm.RunScript;
begin
with CurrScript do
begin
@@ -821,7 +824,7 @@ begin
end;
end;
-procedure TForm1.PauseScript;
+procedure TSimbaForm.PauseScript;
begin
with CurrScript do
begin;
@@ -841,7 +844,7 @@ begin
end;
end;
-procedure TForm1.StopScript;
+procedure TSimbaForm.StopScript;
begin
with CurrScript do
begin;
@@ -869,7 +872,7 @@ begin
end;
end;
-procedure TForm1.AddTab;
+procedure TSimbaForm.AddTab;
var
Tab : TMufasaTab;
begin;
@@ -886,7 +889,7 @@ begin;
end;
end;
-function TForm1.DeleteTab(TabIndex: integer; CloseLast : boolean; Silent : boolean = false) : boolean;
+function TSimbaForm.DeleteTab(TabIndex: integer; CloseLast : boolean; Silent : boolean = false) : boolean;
var
Tab : TMufasaTab;
OldIndex : integer;//So that we can switch back, if needed.
@@ -931,12 +934,12 @@ begin
RefreshTab;
end;
-procedure TForm1.ClearTab(TabIndex: integer);
+procedure TSimbaForm.ClearTab(TabIndex: integer);
begin
TMufasaTab(Tabs[TabIndex]).Clear;
end;
-procedure TForm1.CloseTabs(Exclude: integer = -1; Silent : boolean = false);
+procedure TSimbaForm.CloseTabs(Exclude: integer = -1; Silent : boolean = false);
var
I : integer;
begin
@@ -946,7 +949,7 @@ begin
exit;
end;
-procedure TForm1.SetEditActions;
+procedure TSimbaForm.SetEditActions;
procedure EditActions(Undo,Redo,Cut,Copy,Paste,Delete : boolean);
begin;
ActionUndo.Enabled:= Undo;
@@ -994,7 +997,7 @@ begin
EditActions(false,false,false,false,false,false);
end;
-procedure TForm1.DoSearch(Next: boolean; HighlightAll : boolean);
+procedure TSimbaForm.DoSearch(Next: boolean; HighlightAll : boolean);
var
Res : integer;
CurrPos : TPoint;
@@ -1052,7 +1055,7 @@ begin
end;
end;
-procedure TForm1.RefreshTab;
+procedure TSimbaForm.RefreshTab;
var
Tab : TMufasaTab;
Script : TScriptFrame;
@@ -1100,12 +1103,12 @@ begin
SetEditActions;
end;
-procedure TForm1.RefreshTabSender(sender: PtrInt);
+procedure TSimbaForm.RefreshTabSender(sender: PtrInt);
begin
RefreshTab;
end;
-procedure TForm1.CreateDefaultEnvironment;
+procedure TSimbaForm.CreateDefaultEnvironment;
var
PluginsPath,extensionsPath : string;
begin
@@ -1130,7 +1133,7 @@ begin
CreateSetting('Settings/Fonts/VersionLink', FontURL + 'Version');
CreateSetting('Settings/Fonts/UpdateLink', FontURL + 'Fonts.tar.bz2');
- CreateSetting('Settings/News/URL', 'http://simba.villavu.com/bin/news');
+ CreateSetting('Settings/News/URL', 'http://Simba.villavu.com/bin/news');
{Creates the paths and returns the path}
PluginsPath := CreateSetting('Settings/Plugins/Path', ExpandFileName(MainDir+ DS+ 'Plugins' + DS));
@@ -1160,7 +1163,7 @@ begin
UpdateTimer.Interval:=25;
end;
-procedure TForm1.LoadFormSettings;
+procedure TSimbaForm.LoadFormSettings;
var
str,str2 : string;
Data : TStringArray;
@@ -1210,7 +1213,7 @@ begin
self.EndFormUpdate;
end;
-procedure TForm1.SaveFormSettings;
+procedure TSimbaForm.SaveFormSettings;
var
Data : TStringArray;
path : string;
@@ -1256,7 +1259,7 @@ begin
end;
end;
-procedure TForm1.LoadExtensions;
+procedure TSimbaForm.LoadExtensions;
var
extCount : integer;
function LoadExtension(Number : integer) : boolean;
@@ -1306,7 +1309,7 @@ begin
ExtManager.LoadPSExtensionsDir(str,str2);
end;
-procedure TForm1.AddRecentFile(const filename: string);
+procedure TSimbaForm.AddRecentFile(const filename: string);
var
MaxRecentFiles : integer;
Len,i : integer;
@@ -1330,7 +1333,7 @@ begin
RecentFileItems[len - 1-i].Caption:= ExtractFileName(RecentFiles[i]);
end;
-procedure TForm1.InitalizeTMThread(var Thread: TMThread);
+procedure TSimbaForm.InitalizeTMThread(var Thread: TMThread);
var
DbgImgInfo : TDbgImgInfo;
AppPath : string;
@@ -1412,27 +1415,39 @@ begin
Thread.OpenFileEvent:=@ThreadOpenFileEvent;
end;
-procedure TForm1.HandleParameters;
+procedure TSimbaForm.HandleParameters;
var
DoRun : Boolean;
ErrorMsg : string;
begin
DoRun := false;
- if Paramcount = 1 then
+ // paramcount = 1 means we got only one parameter. We assume this to be a file.
+ // and try to open it accordingly
+ if (Paramcount = 1) and not (Application.HasOption('open')) then
begin
+ writeln('Opening file: ' + ParamStr(1));
if FileExists(ParamStr(1)) then
+ begin
LoadScriptFile(paramstr(1));
+ end;
end else
- begin;
- ErrorMsg:=Application.CheckOptions('ro:','run open:');
+ // we have more parameters. Check for specific options. (-r -o, --run --open)
+ begin
+ ErrorMsg:=Application.CheckOptions('ro:',['run', 'open:']);
if ErrorMsg <> '' then
- mDebugLn(ErrorMSG)
- else
+ begin
+ mDebugLn('ERROR IN COMMAND LINE ARGS: ' + ErrorMSG)
+ end else
begin
if Application.HasOption('o','open') then
- begin;
+ begin
+ writeln('Opening file: ' + Application.GetOptionValue('o','open'));
LoadScriptFile(Application.GetOptionValue('o','open'));
DoRun:= Application.HasOption('r','run');
+ end else
+ // no valid options
+ begin
+ writeln('No valid command line args are passed');
end;
end;
end;
@@ -1440,7 +1455,7 @@ begin
Self.RunScript;
end;
-procedure TForm1.OnSaveScript(const Filename: string);
+procedure TSimbaForm.OnSaveScript(const Filename: string);
begin
with CurrScript do
begin
@@ -1460,7 +1475,7 @@ begin
end;
-procedure TForm1.ActionTabLastExecute(Sender: TObject);
+procedure TSimbaForm.ActionTabLastExecute(Sender: TObject);
var
CurrIndex : integer;
begin
@@ -1472,7 +1487,7 @@ begin
PageControl1.TabIndex:= CurrIndex;
end;
-procedure TForm1.ActionCloseTabExecute(Sender: TObject);
+procedure TSimbaForm.ActionCloseTabExecute(Sender: TObject);
begin
if(PageControl1.PageCount > 1)then
Self.DeleteTab(PageControl1.TabIndex,false)
@@ -1480,7 +1495,7 @@ begin
Self.ClearScript; //DeleteTab would take care of this already, but yeah, it's neater this way.
end;
-procedure TForm1.ActionCompileScriptExecute(Sender: TObject);
+procedure TSimbaForm.ActionCompileScriptExecute(Sender: TObject);
var
TempThread : TMThread;
begin
@@ -1489,14 +1504,14 @@ begin
TempThread.Resume;
end;
-procedure TForm1.ActionConsoleExecute(Sender: TObject);
+procedure TSimbaForm.ActionConsoleExecute(Sender: TObject);
begin
{$ifdef mswindows}
ShowConsole(not ConsoleVisible);
{$endif}
end;
-procedure TForm1.ActionCopyExecute(Sender: TObject);
+procedure TSimbaForm.ActionCopyExecute(Sender: TObject);
begin
if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then
CurrScript.SynEdit.CopyToClipboard
@@ -1504,7 +1519,7 @@ begin
Memo1.CopyToClipboard;
end;
-procedure TForm1.ActionCutExecute(Sender: TObject);
+procedure TSimbaForm.ActionCutExecute(Sender: TObject);
begin
if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then
CurrScript.SynEdit.CutToClipboard
@@ -1512,7 +1527,7 @@ begin
Memo1.CutToClipboard;
end;
-procedure TForm1.ActionDeleteExecute(Sender: TObject);
+procedure TSimbaForm.ActionDeleteExecute(Sender: TObject);
begin
if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then
CurrScript.SynEdit.ClearSelection
@@ -1520,17 +1535,17 @@ begin
Memo1.ClearSelection;
end;
-procedure TForm1.ActionExitExecute(Sender: TObject);
+procedure TSimbaForm.ActionExitExecute(Sender: TObject);
begin
Self.Close;
end;
-procedure TForm1.ActionFindNextExecute(Sender: TObject);
+procedure TSimbaForm.ActionFindNextExecute(Sender: TObject);
begin
DoSearch(true, false);
end;
-procedure TForm1.ActionFindstartExecute(Sender: TObject);
+procedure TSimbaForm.ActionFindstartExecute(Sender: TObject);
begin
if frmFunctionList.Focused or frmFunctionList.FunctionList.Focused or frmFunctionList.editSearchList.Focused then
begin
@@ -1544,23 +1559,23 @@ begin
end;
end;
-procedure TForm1.ActionClearDebugExecute(Sender: TObject);
+procedure TSimbaForm.ActionClearDebugExecute(Sender: TObject);
begin
Memo1.Clear;
end;
-procedure TForm1.ActionNewExecute(Sender: TObject);
+procedure TSimbaForm.ActionNewExecute(Sender: TObject);
begin
//Self.ClearScript;
Self.AddTab;
end;
-procedure TForm1.ActionNewTabExecute(Sender: TObject);
+procedure TSimbaForm.ActionNewTabExecute(Sender: TObject);
begin
Self.AddTab;
end;
-procedure TForm1.ActionNormalSizeExecute(Sender: TObject);
+procedure TSimbaForm.ActionNormalSizeExecute(Sender: TObject);
var
SizeStr : string;
Data : TStringArray;
@@ -1578,12 +1593,12 @@ begin
end;
end;
-procedure TForm1.ActionOpenExecute(Sender: TObject);
+procedure TSimbaForm.ActionOpenExecute(Sender: TObject);
begin
Self.OpenScript;
end;
-procedure TForm1.ActionPasteExecute(Sender: TObject);
+procedure TSimbaForm.ActionPasteExecute(Sender: TObject);
begin
if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then
CurrScript.SynEdit.PasteFromClipboard
@@ -1596,12 +1611,12 @@ begin
end;
-procedure TForm1.ActionPauseExecute(Sender: TObject);
+procedure TSimbaForm.ActionPauseExecute(Sender: TObject);
begin
Self.PauseScript;
end;
-procedure TForm1.ActionRedoExecute(Sender: TObject);
+procedure TSimbaForm.ActionRedoExecute(Sender: TObject);
begin
if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then
CurrScript.Redo
@@ -1609,19 +1624,19 @@ begin
Memo1.Undo; //?
end;
-procedure TForm1.ActionReplaceExecute(Sender: TObject);
+procedure TSimbaForm.ActionReplaceExecute(Sender: TObject);
begin
if(ScriptPopup.HandleAllocated)then
dlgReplace.FindText:= CurrScript.SynEdit.SelText;
dlgReplace.Execute;
end;
-procedure TForm1.ActionRunExecute(Sender: TObject);
+procedure TSimbaForm.ActionRunExecute(Sender: TObject);
begin
Self.RunScript;
end;
-procedure TForm1.ActionSaveAllExecute(Sender: TObject);
+procedure TSimbaForm.ActionSaveAllExecute(Sender: TObject);
var
i : integer;
OldIndex : integer;
@@ -1635,17 +1650,17 @@ begin
PageControl1.TabIndex:= oldindex;
end;
-procedure TForm1.ActionSaveAsExecute(Sender: TObject);
+procedure TSimbaForm.ActionSaveAsExecute(Sender: TObject);
begin
Self.SaveCurrentScriptAs;
end;
-procedure TForm1.ActionSaveExecute(Sender: TObject);
+procedure TSimbaForm.ActionSaveExecute(Sender: TObject);
begin
Self.SaveCurrentScript;
end;
-procedure TForm1.ActionSelectAllExecute(Sender: TObject);
+procedure TSimbaForm.ActionSelectAllExecute(Sender: TObject);
begin
if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then
CurrScript.SynEdit.SelectAll
@@ -1656,12 +1671,12 @@ begin
end;
-procedure TForm1.ActionStopExecute(Sender: TObject);
+procedure TSimbaForm.ActionStopExecute(Sender: TObject);
begin
Self.StopScript;
end;
-procedure TForm1.ActionTabNextExecute(Sender: TObject);
+procedure TSimbaForm.ActionTabNextExecute(Sender: TObject);
var
CurrIndex : integer;
begin
@@ -1673,7 +1688,7 @@ begin
PageControl1.TabIndex:= CurrIndex;
end;
-procedure TForm1.ActionUndoExecute(Sender: TObject);
+procedure TSimbaForm.ActionUndoExecute(Sender: TObject);
begin
if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then
CurrScript.Undo
@@ -1681,7 +1696,7 @@ begin
Memo1.Undo;
end;
-procedure TForm1.ChangeMouseStatus(Sender: TObject);
+procedure TSimbaForm.ChangeMouseStatus(Sender: TObject);
var
x, y: Integer;
begin
@@ -1697,7 +1712,7 @@ begin
StatusBar.Panels[Panel_Coords].Text := Format('(%d, %d)', [x, y]);
end;
-procedure TForm1.CheckBoxMatchCaseClick(Sender: TObject);
+procedure TSimbaForm.CheckBoxMatchCaseClick(Sender: TObject);
begin
RefreshTab;
CurrScript.SynEdit.MarkupByClass[TSynEditMarkupHighlightAllCaret].TempDisable;
@@ -1709,7 +1724,7 @@ end;
-procedure TForm1.CloseFindPanel;
+procedure TSimbaForm.CloseFindPanel;
begin
SearchPanel.Visible:= false;
if CurrScript.SynEdit.CanFocus then
@@ -1720,13 +1735,13 @@ end;
If we are being sent to the background; then minimize other active windows as
well.
}
-procedure TForm1.doOnHide(Sender: TObject);
+procedure TSimbaForm.doOnHide(Sender: TObject);
begin
if DebugImgForm.Visible then
DebugImgForm.Hide;
end;
-procedure TForm1.StopCodeCompletion;
+procedure TSimbaForm.StopCodeCompletion;
begin
CodeCompletionForm.Hide;
if frmFunctionList.InCodeCompletion then
@@ -1748,12 +1763,12 @@ begin
end;
end;
-function TForm1.FindTab(filename: string): integer;
+function TSimbaForm.FindTab(filename: string): integer;
var
i : integer;
begin
FileName := SetDirSeparators(filename);
- for i := 0 to Form1.Tabs.Count - 1 do
+ for i := 0 to SimbaForm.Tabs.Count - 1 do
{$ifdef MSWindows} //Case insensitive
if lowercase(TMufasaTab(Tabs[i]).ScriptFrame.ScriptFile) = lowercase(filename) then
{$else}
@@ -1763,13 +1778,13 @@ begin
result := -1;
end;
-procedure TForm1.editSearchListExit(Sender: TObject);
+procedure TSimbaForm.editSearchListExit(Sender: TObject);
begin
frmFunctionList.editSearchList.Color := clWhite;
StopCodeCompletion;
end;
-procedure TForm1.editSearchListKeyDown(Sender: TObject; var Key: Word;
+procedure TSimbaForm.editSearchListKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key = vk_up then
@@ -1784,7 +1799,7 @@ begin
end;
end;
-procedure TForm1.editSearchListKeyPress(Sender: TObject; var Key: char);
+procedure TSimbaForm.editSearchListKeyPress(Sender: TObject; var Key: char);
var
linetext : string;
begin
@@ -1819,7 +1834,7 @@ begin
end;
end;
-procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of String
+procedure TSimbaForm.FormDropFiles(Sender: TObject; const FileNames: array of String
);
var
i : integer;
@@ -1845,7 +1860,7 @@ begin
{$EndIf};
end;
-procedure TForm1.FunctionListChange(Sender: TObject; Node: TTreeNode);
+procedure TSimbaForm.FunctionListChange(Sender: TObject; Node: TTreeNode);
var
MethodInfo : TMethodInfo;
begin
@@ -1860,33 +1875,42 @@ begin
end;
end;
-procedure TForm1.FunctionListEnter(Sender: TObject);
+procedure TSimbaForm.FunctionListEnter(Sender: TObject);
begin
frmFunctionList.LoadScriptTree(CurrScript.SynEdit.Text);
end;
-procedure TForm1.FunctionListExit(Sender: TObject);
+procedure TSimbaForm.FunctionListExit(Sender: TObject);
begin
// StatusBar.Panels[2].Text:= '';
end;
-procedure TForm1.FunctionListTimerTimer(Sender: TObject);
+procedure TSimbaForm.FunctionListTimerTimer(Sender: TObject);
begin
if Self.Visible and (CurrScript <> nil) then
frmFunctionList.LoadScriptTree(CurrScript.SynEdit.Text);
end;
-procedure TForm1.MenuItemExtensionsClick(Sender: TObject);
+procedure TSimbaForm.MenuItemBitmapConvClick(Sender: TObject);
begin
- ExtensionsForm.Show;
+ BitmapConvForm.Show;
end;
-procedure TForm1.MenuItemHandbookClick(Sender: TObject);
+procedure TSimbaForm.MenuItemExtensionsClick(Sender: TObject);
begin
- OpenURL('http://wizzup.org/static/simba/doc/ps_handbook/');
+ MenuItemExtensions.Checked := not ExtensionsForm.Visible;
+ if MenuItemExtensions.Checked then
+ ExtensionsForm.Show
+ else
+ ExtensionsForm.Hide;
end;
-procedure TForm1.MenuItemColourHistoryClick(Sender: TObject);
+procedure TSimbaForm.MenuItemHandbookClick(Sender: TObject);
+begin
+ OpenURL('http://wizzup.org/static/Simba/doc/ps_handbook/');
+end;
+
+procedure TSimbaForm.MenuItemColourHistoryClick(Sender: TObject);
begin
MenuItemColourHistory.Checked := not ColourHistoryForm.Visible;
if MenuItemColourHistory.Checked then
@@ -1895,13 +1919,13 @@ begin
ColourHistoryForm.Hide;
end;
-procedure TForm1.dlgReplaceFind(Sender: TObject);
+procedure TSimbaForm.dlgReplaceFind(Sender: TObject);
begin
SearchString := dlgReplace.FindText;
DoSearch(True, False);
end;
-procedure TForm1.dlgReplaceReplace(Sender: TObject);
+procedure TSimbaForm.dlgReplaceReplace(Sender: TObject);
var
SOptions: TSynSearchOptions;
P: TPoint;
@@ -1940,13 +1964,13 @@ begin
end;
end;
-procedure TForm1.EditSearchChange(Sender: TObject);
+procedure TSimbaForm.EditSearchChange(Sender: TObject);
begin
SearchString :=LabeledEditSearch.Text;
DoSearch(false, true);
end;
-procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
+procedure TSimbaForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
i : integer;
begin
@@ -1969,21 +1993,21 @@ var
b: TStringList;
ms: TMemoryStream;
begin
- if form1.UpdatingFonts then
+ if SimbaForm.UpdatingFonts then
begin
mDebugLn('Updating the fonts, thus waiting a bit till we init the OCR.');
- while form1.UpdatingFonts do
+ while SimbaForm.UpdatingFonts do
begin
if GetCurrentThreadId = MainThreadID then
Application.ProcessMessages;
sleep(25);
end;
end;
- form1.InitalizeTMThread(t);
+ SimbaForm.InitalizeTMThread(t);
KillThread(t.ThreadID);
if (t is TPSThread) then
try
- a := TPSScriptExtension.Create(form1);
+ a := TPSScriptExtension.Create(SimbaForm);
b := TStringList.Create;
ms := TMemoryStream.Create;
@@ -2003,7 +2027,7 @@ begin
CoreBuffer[0] := TCodeInsight.Create;
with CoreBuffer[0] do
begin
- OnMessage := @form1.OnCCMessage;
+ OnMessage := @SimbaForm.OnCCMessage;
b.SaveToStream(ms);
Run(ms, nil, -1, True);
FileName := '"PSCORE"';
@@ -2018,7 +2042,7 @@ begin
end;
end;
-procedure TForm1.FormCreate(Sender: TObject);
+procedure TSimbaForm.FormCreate(Sender: TObject);
var
FillThread : TProcThread;
begin
@@ -2100,7 +2124,7 @@ begin
self.EndFormUpdate;
end;
-procedure TForm1.FormDestroy(Sender: TObject);
+procedure TSimbaForm.FormDestroy(Sender: TObject);
var
i : integer;
begin
@@ -2125,7 +2149,7 @@ begin
{$endif}
end;
-procedure TForm1.FormShortCuts(var Msg: TLMKey; var Handled: Boolean);
+procedure TSimbaForm.FormShortCuts(var Msg: TLMKey; var Handled: Boolean);
begin
SetEditActions;
Handled := ActionList.IsShortCut(Msg);
@@ -2133,7 +2157,7 @@ end;
-procedure TForm1.LabeledEditSearchEnter(Sender: TObject);
+procedure TSimbaForm.LabeledEditSearchEnter(Sender: TObject);
begin
SearchStart := CurrScript.SynEdit.LogicalCaretXY;
with CurrScript.SynEdit do
@@ -2143,13 +2167,13 @@ begin
end;
end;
-procedure TForm1.LabeledEditSearchExit(Sender: TObject);
+procedure TSimbaForm.LabeledEditSearchExit(Sender: TObject);
begin
if not CheckBoxMatchCase.MouseEntered then
RefreshTab;
end;
-procedure TForm1.LabeledEditSearchKeyDown(Sender: TObject; var Key: Word;
+procedure TSimbaForm.LabeledEditSearchKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (ssCtrl in Shift) and (key = vk_f) then
@@ -2163,7 +2187,7 @@ begin
end;
end;
-procedure TForm1.LabeledEditSearchKeyPress(Sender: TObject; var Key: char);
+procedure TSimbaForm.LabeledEditSearchKeyPress(Sender: TObject; var Key: char);
begin
if key = #13 then
begin;
@@ -2174,22 +2198,22 @@ begin
end;
end;
-procedure TForm1.MenuEditClick(Sender: TObject);
+procedure TSimbaForm.MenuEditClick(Sender: TObject);
begin
SetEditActions;
end;
-procedure TForm1.MenuItemAboutClick(Sender: TObject);
+procedure TSimbaForm.MenuItemAboutClick(Sender: TObject);
begin
AboutForm.ShowModal;
end;
-procedure TForm1.MenuItemCloseTabsClick(Sender: TObject);
+procedure TSimbaForm.MenuItemCloseTabsClick(Sender: TObject);
begin
Self.CloseTabs;
end;
-procedure TForm1.MenuItemDebugImageClick(Sender: TObject);
+procedure TSimbaForm.MenuItemDebugImageClick(Sender: TObject);
begin
MenuItemDebugImage.Checked := not DebugImgForm.Visible;
if MenuItemDebugImage.Checked then
@@ -2198,7 +2222,7 @@ begin
DebugImgForm.Hide;
end;
-procedure TForm1.MenuItemExportHTMLClick(Sender: TObject);
+procedure TSimbaForm.MenuItemExportHTMLClick(Sender: TObject);
var
SynExporterHTML : TSynExporterHTML;
begin;
@@ -2227,7 +2251,7 @@ end;
procedure formWritelnEx(S: String);
begin
- Form1.Memo1.Lines.Add(s);
+ SimbaForm.Memo1.Lines.Add(s);
end;
function GetMethodName( Decl : string; PlusNextChar : boolean) : string;
@@ -2257,7 +2281,7 @@ begin;
result := result + ';';
end;
-procedure TForm1.MenuitemFillFunctionListClick(Sender: TObject);
+procedure TSimbaForm.MenuitemFillFunctionListClick(Sender: TObject);
var
Methods : TExpMethodArr;
LastSection : string;
@@ -2312,7 +2336,7 @@ begin
frmFunctionList.LoadScriptTree(CurrScript.SynEdit.Text);
end;
-procedure TForm1.MenuItemHideClick(Sender: TObject);
+procedure TSimbaForm.MenuItemHideClick(Sender: TObject);
begin
if Self.Visible = false then
MenuItemShowClick(sender)
@@ -2320,49 +2344,49 @@ begin
Self.Hide;
end;
-procedure TForm1.MenuItemReportBugClick(Sender: TObject);
+procedure TSimbaForm.MenuItemReportBugClick(Sender: TObject);
begin
OpenURL('http://mufasa.villavu.com/mantis/bug_report_page.php');
end;
-procedure TForm1.MenuItemSettingsButtonClick(Sender: TObject);
+procedure TSimbaForm.MenuItemSettingsButtonClick(Sender: TObject);
begin
SettingsForm.ShowModal;
end;
-procedure TForm1.MenuItemShowClick(Sender: TObject);
+procedure TSimbaForm.MenuItemShowClick(Sender: TObject);
begin
Self.Show;
Self.WindowState := wsNormal;
end;
-procedure TForm1.MenuItemTabCloseClick(Sender: TObject);
+procedure TSimbaForm.MenuItemTabCloseClick(Sender: TObject);
begin
DeleteTab(PopupTab,false);
end;
-procedure TForm1.MenuItemTabCloseOthersClick(Sender: TObject);
+procedure TSimbaForm.MenuItemTabCloseOthersClick(Sender: TObject);
begin
CloseTabs(PopupTab);
end;
-procedure TForm1.MenuItemFunctionListClick(Sender: TObject);
+procedure TSimbaForm.MenuItemFunctionListClick(Sender: TObject);
begin
FunctionListShown(not MenuItemFunctionList.Checked);
end;
-procedure TForm1.MTrayIconClick(Sender: TObject);
+procedure TSimbaForm.MTrayIconClick(Sender: TObject);
begin
self.Show;
if Self.CanFocus then
self.SetFocus;
end;
-function TForm1.GetSimbaNews: String;
+function TSimbaForm.GetSimbaNews: String;
var
t: TDownloadThread;
begin
- t := TDownloadThread.Create(LoadSettingDef('Settings/News/URL', 'http://simba.villavu.com/bin/news'),
+ t := TDownloadThread.Create(LoadSettingDef('Settings/News/URL', 'http://Simba.villavu.com/bin/news'),
@Result);
t.Resume;
while not t.done do
@@ -2372,12 +2396,12 @@ begin
end;
end;
-procedure TForm1.SetExtPath(const AValue: string);
+procedure TSimbaForm.SetExtPath(const AValue: string);
begin
SetSetting('Settings/Extensions/Path',AValue,true);
end;
-procedure TForm1.NewsTimerTimer(Sender: TObject);
+procedure TSimbaForm.NewsTimerTimer(Sender: TObject);
var
s: String;
News : TStringList; {Need it for correct EOL stuff}
@@ -2391,7 +2415,7 @@ begin
News.free;
end;
-procedure TForm1.OnLinePSScript(Sender: TObject);
+procedure TSimbaForm.OnLinePSScript(Sender: TObject);
begin
{$IFDEF ProcessMessages}
Application.ProcessMessages; //Don't think that this is neccesary though
@@ -2400,7 +2424,7 @@ end;
-procedure TForm1.ButtonPickClick(Sender: TObject);
+procedure TSimbaForm.ButtonPickClick(Sender: TObject);
var
c, x, y: Integer;
cobj: TColourPickerObject;
@@ -2417,30 +2441,30 @@ begin
end;
-procedure TForm1.ButtonSelectorDown(Sender: TObject; Button: TMouseButton;
+procedure TSimbaForm.ButtonSelectorDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Manager.SetTarget(Selector.Drag);
FormWritelnEx('New window: ' + IntToStr(Selector.LastPick));
end;
-procedure TForm1.PageControl1Change(Sender: TObject);
+procedure TSimbaForm.PageControl1Change(Sender: TObject);
begin
RefreshTab();
end;
-procedure TForm1.ButtonTrayClick(Sender: TObject);
+procedure TSimbaForm.ButtonTrayClick(Sender: TObject);
begin
self.hide;
end;
-procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean
+procedure TSimbaForm.PageControl1Changing(Sender: TObject; var AllowChange: Boolean
);
begin
LastTab:= PageControl1.TabIndex;
end;
-procedure TForm1.PageControl1ContextPopup(Sender: TObject; MousePos: TPoint;
+procedure TSimbaForm.PageControl1ContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
begin
PopupTab := PageControl1.TabIndexAtClientPos(MousePos);
@@ -2451,7 +2475,7 @@ begin
end;
end;
-procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer);
+procedure TSimbaForm.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
NewPos : integer;
OldPos : integer;
@@ -2467,7 +2491,7 @@ begin
end;
end;
-procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X, Y: Integer;
+procedure TSimbaForm.PageControl1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
Pos: Integer;
@@ -2476,7 +2500,7 @@ begin
Accept := (Pos <> PageControl1.TabIndex) and (Pos <> -1);
end;
-procedure TForm1.PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
+procedure TSimbaForm.PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if(Button = mbLeft)then
@@ -2488,7 +2512,7 @@ begin
end;
end;
-procedure TForm1.PageControl1MouseUp(Sender: TObject; Button: TMouseButton;
+procedure TSimbaForm.PageControl1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if(Button = mbMiddle) and (not(PageControl1.Dragging))then
@@ -2496,7 +2520,7 @@ begin
DeleteTab(PageControl1.TabIndexAtClientPos(Classes.Point(x,y)), False);
end;
-procedure TForm1.PickerPick(Sender: TObject; const Colour, colourx,
+procedure TSimbaForm.PickerPick(Sender: TObject; const Colour, colourx,
coloury: integer);
var
Args : TVariantArray;
@@ -2508,38 +2532,38 @@ begin
ExtManager.HandleHook(EventHooks[SExt_OnColourPick].HookName,Args);
end;
-procedure TForm1.PopupItemFindClick(Sender: TObject);
+procedure TSimbaForm.PopupItemFindClick(Sender: TObject);
begin
SearchString := CurrScript.SynEdit.SelText;
ActionFindNextExecute(ScriptPopup);
end;
-function TForm1.GetScriptState: TScriptState;
+function TSimbaForm.GetScriptState: TScriptState;
begin
result := CurrScript.FScriptState;
end;
-function TForm1.GetShowHintAuto: boolean;
+function TSimbaForm.GetShowHintAuto: boolean;
begin
Result := LowerCase(LoadSettingDef('Settings/CodeHints/ShowAutomatically','True')) = 'true';
end;
-procedure TForm1.SetFontPath(const AValue: String);
+procedure TSimbaForm.SetFontPath(const AValue: String);
begin
SetSetting('Settings/Fonts/Path',AValue,true);
end;
-function TForm1.GetFontPath: String;
+function TSimbaForm.GetFontPath: String;
begin
Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Fonts/Path', ExpandFileName(MainDir+DS+'Fonts' + DS)));
end;
-function TForm1.GetExtPath: string;
+function TSimbaForm.GetExtPath: string;
begin
result :=IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Extensions/Path', ExpandFileName(MainDir+DS+'Extensions' + DS)));
end;
-function TForm1.GetHighlighter: TSynCustomHighlighter;
+function TSimbaForm.GetHighlighter: TSynCustomHighlighter;
begin
if lowercase(LoadSettingDef('Settings/SourceEditor/LazColors','True')) = 'true' then
result := LazHighlighter
@@ -2547,32 +2571,32 @@ begin
result := SCARHighlighter;
end;
-function TForm1.GetIncludePath: String;
+function TSimbaForm.GetIncludePath: String;
begin
Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Includes/Path', ExpandFileName(MainDir+DS+'Includes' + DS)));
end;
-function TForm1.GetPluginPath: string;
+function TSimbaForm.GetPluginPath: string;
begin
Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Plugins/Path', ExpandFileName(MainDir+DS+'Plugins' + DS)));
end;
-procedure TForm1.SetIncludePath(const AValue: String);
+procedure TSimbaForm.SetIncludePath(const AValue: String);
begin
SetSetting('Settings/Includes/Path',AValue,true);
end;
-procedure TForm1.SetPluginPath(const AValue: string);
+procedure TSimbaForm.SetPluginPath(const AValue: string);
begin
SetSetting('Settings/Plugins/Path',AValue,true);
end;
-procedure TForm1.SetScriptPath(const AValue: string);
+procedure TSimbaForm.SetScriptPath(const AValue: string);
begin
SetSetting('Settings/Scripts/Path',AValue,True);
end;
-procedure TForm1.SetScriptState(const State: TScriptState);
+procedure TSimbaForm.SetScriptState(const State: TScriptState);
begin
CurrScript.FScriptState:= State;
with Self.StatusBar.panels[Panel_State] do
@@ -2600,17 +2624,17 @@ begin
end;
end;
-function TForm1.LoadSettingDef(const Key,Def: string): string;
+function TSimbaForm.LoadSettingDef(const Key,Def: string): string;
begin
result := SettingsForm.Settings.GetKeyValueDefLoad(Key,def,SimbaSettingsFile);
end;
-function TForm1.CreateSetting(const Key,Value: string): string;
+function TSimbaForm.CreateSetting(const Key,Value: string): string;
begin
result := SettingsForm.Settings.GetKeyValueDef(Key,value);
end;
-procedure TForm1.SetSetting(const key,Value: string; save : boolean);
+procedure TSimbaForm.SetSetting(const key,Value: string; save : boolean);
begin
//Creates the setting if needed
SettingsForm.Settings.SetKeyValue(key,value);
@@ -2618,12 +2642,12 @@ begin
SettingsForm.Settings.SaveToXML(SimbaSettingsFile);
end;
-function TForm1.SettingExtists(const key: string): boolean;
+function TSimbaForm.SettingExtists(const key: string): boolean;
begin
result :=SettingsForm.Settings.KeyExists(key);
end;
-procedure TForm1.FontUpdate;
+procedure TSimbaForm.FontUpdate;
procedure Idler;
begin
Application.ProcessMessages;
@@ -2685,7 +2709,7 @@ begin
UpdatingFonts := False;
end;
-procedure TForm1.ScriptStartEvent(Sender: TObject; var Script: string;
+procedure TSimbaForm.ScriptStartEvent(Sender: TObject; var Script: string;
var Continue: boolean);
begin
ScriptStartData.Sender:=Sender;
@@ -2694,7 +2718,7 @@ begin
TThread.Synchronize(nil,@HandleScriptStartData);
end;
-procedure TForm1.SetShowHintAuto(const AValue: boolean);
+procedure TSimbaForm.SetShowHintAuto(const AValue: boolean);
begin
SetSetting('Settings/CodeHints/ShowAutomatically',Booltostr(AValue,true));
end;
@@ -2702,7 +2726,7 @@ end;
{$ifdef mswindows}
function GetConsoleWindow: HWND; stdcall; external kernel32 name 'GetConsoleWindow';
-procedure TForm1.ShowConsole(ShowIt: boolean);
+procedure TSimbaForm.ShowConsole(ShowIt: boolean);
var
ProcessId : DWOrd;
begin
@@ -2722,7 +2746,7 @@ begin
end;
{$endif}
-procedure TForm1.FunctionListShown(ShowIt: boolean);
+procedure TSimbaForm.FunctionListShown(ShowIt: boolean);
begin
with MenuItemFunctionList, frmFunctionList do
begin
@@ -2754,7 +2778,7 @@ begin
end;
-procedure TForm1.SafeCallThread;
+procedure TSimbaForm.SafeCallThread;
var
thread: TMThread;
LocalCopy : TSyncInfo;
@@ -2781,7 +2805,7 @@ begin
end;
end;
-function TForm1.OpenScript: boolean;
+function TSimbaForm.OpenScript: boolean;
var
OpenInNewTab : boolean;
begin
@@ -2792,7 +2816,7 @@ begin
Exit;
with TOpenDialog.Create(nil) do
try
- Filter:= 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt;*.' +LoadSettingDef('Settings/Extensions/FileExtension','sex')+
+ Filter:= 'Simba Files|*.Simba;*.simb;*.cogat;*.mufa;*.txt;*.' +LoadSettingDef('Settings/Extensions/FileExtension','sex')+
'|Any files|*.*';
if Execute then
if FileExists(filename) then
@@ -2802,7 +2826,7 @@ begin
end;
end;
-function TForm1.LoadScriptFile(filename: string; AlwaysOpenInNewTab: boolean; CheckOtherTabs : boolean
+function TSimbaForm.LoadScriptFile(filename: string; AlwaysOpenInNewTab: boolean; CheckOtherTabs : boolean
): boolean;
var
OpenInNewTab : boolean;
@@ -2846,7 +2870,7 @@ begin
end;
end;
-function TForm1.SaveCurrentScript: boolean;
+function TSimbaForm.SaveCurrentScript: boolean;
begin
with CurrScript do
begin
@@ -2867,21 +2891,21 @@ begin
end;
end;
-function TForm1.SaveCurrentScriptAs: boolean;
+function TSimbaForm.SaveCurrentScriptAs: boolean;
var
ScriptFile : string;
begin
Result := false;
with TSaveDialog.Create(nil) do
try
- filter := 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt;*.' +
+ filter := 'Simba Files|*.Simba;*.simb;*.cogat;*.mufa;*.txt;*.' +
LoadSettingDef('Settings/Extensions/FileExtension','sex')+
'|Any files|*.*';
if Execute then
begin;
if ExtractFileExt(FileName) = '' then
begin;
- ScriptFile := FileName + '.simba';
+ ScriptFile := FileName + '.Simba';
end else
ScriptFile := FileName;
CurrScript.SynEdit.Lines.SaveToFile(ScriptFile);
@@ -2892,7 +2916,7 @@ begin
end;
end;
-function TForm1.CanExitOrOpen: boolean;
+function TSimbaForm.CanExitOrOpen: boolean;
begin;
Self.Enabled := False;//We HAVE to answer the popup
Result := True;
@@ -2925,7 +2949,7 @@ begin;
Self.SetFocus;
end;
-function TForm1.ClearScript: boolean;
+function TSimbaForm.ClearScript: boolean;
begin
result := false;
if CanExitOrOpen then
@@ -2960,7 +2984,7 @@ end;
destructor TMufasaTab.Destroy;
begin
- ScriptFrame.Free;
+// ScriptFrame.Free;
TabSheet.Free;
inherited Destroy;
end;
diff --git a/Projects/SAMufasaGUI/simpleanalyzer.pas b/Projects/Simba/simpleanalyzer.pas
similarity index 100%
rename from Projects/SAMufasaGUI/simpleanalyzer.pas
rename to Projects/Simba/simpleanalyzer.pas
diff --git a/Projects/SAMufasaGUI/updateform.lfm b/Projects/Simba/updateform.lfm
similarity index 100%
rename from Projects/SAMufasaGUI/updateform.lfm
rename to Projects/Simba/updateform.lfm
diff --git a/Projects/SAMufasaGUI/updateform.pas b/Projects/Simba/updateform.pas
similarity index 94%
rename from Projects/SAMufasaGUI/updateform.pas
rename to Projects/Simba/updateform.pas
index 48880e1..c1dbc13 100644
--- a/Projects/SAMufasaGUI/updateform.pas
+++ b/Projects/Simba/updateform.pas
@@ -63,32 +63,32 @@ const
DownloadSpeedTextEnded = 'Downloaded at %d kB/s';
SimbaURL = {$IFDEF WINDOWS}
{$IFDEF CPUI386}
- 'http://simba.villavu.com/bin/Windows/x86/Stable/'
+ 'http://Simba.villavu.com/bin/Windows/x86/Stable/'
{$ELSE}
- 'http://simba.villavu.com/bin/Windows/x86_64/Stable/'
+ 'http://Simba.villavu.com/bin/Windows/x86_64/Stable/'
{$ENDIF}
{$ELSE}
{$IFDEF CPUI386}
- 'http://simba.villavu.com/bin/Linux/x86/Stable/'
+ 'http://Simba.villavu.com/bin/Linux/x86/Stable/'
{$ELSE}
- 'http://simba.villavu.com/bin/Linux/x86_64/Stable/'
+ 'http://Simba.villavu.com/bin/Linux/x86_64/Stable/'
{$ENDIF}
{$ENDIF};
- FontURL = 'http://simba.villavu.com/bin/Fonts/';
+ FontURL = 'http://Simba.villavu.com/bin/Fonts/';
var
SimbaUpdateForm: TSimbaUpdateForm;
implementation
uses
- internets, TestUnit, simbasettings,lclintf;
+ internets, SimbaUnit, Simbasettings,lclintf;
function TSimbaUpdateForm.CanUpdate: Boolean;
begin
GetLatestSimbaVersion;
- mDebugLn(format('Current Simba version: %d',[TestUnit.SimbaVersion]));
+ mDebugLn(format('Current Simba version: %d',[SimbaUnit.SimbaVersion]));
mDebugLn('Latest Simba Version: ' + IntToStr(FSimbaVersion));
- Exit(testunit.SimbaVersion < FSimbaVersion);
+ Exit(SimbaUnit.SimbaVersion < FSimbaVersion);
end;
function TSimbaUpdateForm.GetLatestFontVersion: integer;
diff --git a/Projects/SAMufasaGUI/virtualextension.pas b/Projects/Simba/virtualextension.pas
similarity index 100%
rename from Projects/SAMufasaGUI/virtualextension.pas
rename to Projects/Simba/virtualextension.pas
diff --git a/Units/MMLAddon/PSInc/Wrappers/file.inc b/Units/MMLAddon/PSInc/Wrappers/file.inc
index bff5a67..9c7fdd2 100644
--- a/Units/MMLAddon/PSInc/Wrappers/file.inc
+++ b/Units/MMLAddon/PSInc/Wrappers/file.inc
@@ -81,6 +81,21 @@ begin
result := CreateDir(directoryName);
end;
+function ps_ForceDirectores(const dir : string) : boolean; extdecl;
+begin
+ result := ForceDirectories(dir);
+end;
+
+function ps_GetFiles(const Path, Ext : string) : TStringArray;extdecl;
+begin
+ result := GetFiles(path,ext);
+end;
+
+function ps_GetDirectories(const path : string) : TStringArray;extdecl;
+begin
+ result := GetDirectories(path);
+end;
+
procedure ps_WriteINI(const Section, KeyName, NewString, FileName: string);extdecl;
var
tempini : TIniFile;
diff --git a/Units/MMLAddon/PSInc/Wrappers/math.inc b/Units/MMLAddon/PSInc/Wrappers/math.inc
index cdfecb9..4da3848 100644
--- a/Units/MMLAddon/PSInc/Wrappers/math.inc
+++ b/Units/MMLAddon/PSInc/Wrappers/math.inc
@@ -83,9 +83,9 @@ begin
Result:=Random(Abs(aFrom-aTo))+Min(aTo,AFrom);
end;
-function ps_ArcTan2(x,y : extended) : extended; extdecl;
+function ps_ArcTan2(y,x : extended) : extended; extdecl;
begin
- result := ArcTan2(x,y);
+ result := ArcTan2(y,x);
end;
procedure ps_IncEx(var x : integer; increase : integer); extdecl;
@@ -164,12 +164,26 @@ begin
result := ln(x);
end;
-function ps_inttohex(value : integer) : string;
+function ps_inttohex(value : integer) : string; extdecl;
begin
result := IntToHex(value,1);
end;
-function ps_hextoint(hex : string) : integer;
+function ps_hextoint(hex : string) : integer;extdecl;
begin
result := StrToInt('$' + hex);
end;
+function ps_sar(AValue : longint; shift : byte) : longint; extdecl;
+begin;
+ Shift:=Shift and 31;
+ Result:=longint(dword(dword(dword(AValue) shr Shift) or (dword(longint(dword(0-dword(dword(AValue) shr 31)) and dword(longint(0-(ord(Shift<>0){ and 1}))))) shl (32-Shift))));
+end;
+function ps_ror(num : longword; shift : byte) : LongWord; extdecl;
+begin
+ result := RorDWord(num,shift);
+end;
+
+function ps_rol(num : longword; shift : byte) : LongWord; extdecl;
+begin
+ result := RolDWord(num,shift);
+end;
diff --git a/Units/MMLAddon/PSInc/Wrappers/other.inc b/Units/MMLAddon/PSInc/Wrappers/other.inc
index 54a82ab..ade1915 100644
--- a/Units/MMLAddon/PSInc/Wrappers/other.inc
+++ b/Units/MMLAddon/PSInc/Wrappers/other.inc
@@ -158,6 +158,16 @@ procedure ps_HakunaMatata; extdecl;
begin;
OpenWebPage('http://www.youtube.com/v/ejEVczA8PLU&hl=en&fs=1&autoplay=1');
end;
+procedure ps_Simba; extdecl;
+begin
+ psWriteln(DecompressString(Base64Decode('9AoAAHicldU7b+0gDADgvdL9D+AisSDOTrpUvWvGuzNVOkMn9v72a942j6T1dJrEX7AxqRAXYaS9up3iz8suVxoMKe+'+
+ 'NC6LGnbEhiCCfTzPfJ5cmgidj5J9MsezSQAyApGHGR17N9SpGoBj1tkuRkJHoAk3WeMfTC66GWbaTFtMAwZDPRjh73U4uCKGnRTh3NMK0mAjiXxA975iERASl'+
+ 'QjfcRLBVS963TKCQDb0m8Brwwv1IKAWkErcipPNAC5+JdPmY62hE/O3L8yE+T4k4PpGwi2aiEIn25zcqKMQ1a6bgNtGN4kJqJ1tYeqFwrMNDcCFvKjMsWXLOK'+
+ 'N19toPbBN2PmacG9BogFoW7CQD00JTHdZlLml1yQZiv8zzBxGlQzxoxlx+Gdjo8JQDMV8w/0UmCctC/PGZDIKKPFMIGOM8M5IlUyuMel05IwY3hiHoMTLJYdg'+
+ 'RKvhJxsGt5wzKI8PApjpQTQmj5CkIRIO6S3REPXZjD1kyNGxABm60IxLkdu8HqQOaRmt0TcTVVFHzCdq2oX6ae2CMRuo/bWuhdHfMhfSI8PTE3xIjAuIRu7An'+
+ 'hv0kN+e38+1GMPYH/hq1PcyKsywdWvI1n9Y4YXzsLydgSphI4G7i/AexYRTW2RJmBPqFqTcgtUW7T6dgQlwIDfrsIsyDCphcbot5eDPgviZ8Yt0S4Ne4Iuoy/H'+
+ '+//1sR/NLyhCQ==')));
+end;
function ps_Random(Int: integer): integer; extdecl;
begin
diff --git a/Units/MMLAddon/PSInc/Wrappers/strings.inc b/Units/MMLAddon/PSInc/Wrappers/strings.inc
index ffb9a8c..9f22b86 100644
--- a/Units/MMLAddon/PSInc/Wrappers/strings.inc
+++ b/Units/MMLAddon/PSInc/Wrappers/strings.inc
@@ -1 +1 @@
-function ps_Format(const fmt : string;const args : array of const) : string; extdecl;
begin;
Result := Format(fmt,Args);
end;
function ps_Capitalize(str : string) : string;extdecl;
begin
result := Capitalize(str);
end;
function ps_ExtractFromStr( Str : string; Extract : StrExtr) : string; extdecl;
begin
result := extractfromstr(str,extract);
end;
function ps_BoolToStr(bool : boolean) : string; extdecl;
begin;
result := BoolToStr(bool,true);
end;
function ps_Replace(Text, FindStr, ReplaceStr: string; Flags: TReplaceFlags): string; extdecl;
begin;
result := StringReplace(Text,FindStr,ReplaceStr,Flags);
end;
function ps_IntToStr(int : integer) : string; extdecl;
begin
result := inttostr(int);
end;
function ps_FloatToStr(flt : extended) : string; extdecl;
begin
result := floattostr(flt);
end;
function ps_StrToInt(value: String): Integer; extdecl;
begin
result := StrToInt(value);
end;
function ps_StrToIntDef(value: String; default: Integer): Integer; extdecl;
begin
result := StrToIntDef(value,default);
end;
function ps_StrToFloat(value: String): Extended; extdecl;
begin
result := StrToFloat(value);
end;
function ps_StrToFloatDef(value: String; default: Extended): Extended; extdecl;
begin
result := StrToFloatDef(value,default);
end;
function ps_StrToBool(value: String): Boolean;extdecl;
begin
result := StrToBool(value);
end;
function ps_StrToBoolDef(value: String; default: Boolean): Boolean; extdecl;
begin
result := StrToBoolDef(value,default);
end;
function ps_Between(s1, s2, str: string): string; extdecl;
var
I,J : integer;
begin;
Result := '';
I := pos(s1,str);
if I > 0 then
begin;
i := i + length(s1);
j := posex(s2,str,i);
if j > 0 then
Result := copy(str,i,j-i);
end;
end;
function ps_Implode(Glue : string; Pieces: TStringArray): string;extdecl;
begin
result := implode(glue,pieces);
end;
function ps_Explode(del, str: string): TStringArray;extdecl;
begin
result := Explode(del,str);
end;
procedure ps_ExplodeWrap(del, str: string; var res : TStringArray);extdecl;
begin
res := Explode(del,str);
end;
function ps_Padl(s: String; i: longInt): String;extdecl;
begin
result := StringOfChar(Char(' '), i - length(s)) + s;
end;
function ps_Padz(s: String; i: longInt): String;extdecl;
begin
result := StringOfChar(Char('0'), i - length(s)) + s;
end;
function ps_Padr(s: String; i: longInt): String;extdecl;
begin
result := s + StringOfChar(Char(' '), i - Length(s));
end;
function ps_ExecRegExpr( const RegExpr, InputStr : String) : boolean;extdecl;
begin
result := execregexpr(RegExpr,InputStr);
end;
procedure ps_SplitRegExpr( const RegExpr, InputStr : String; Pieces : TStrings);extdecl;
begin
SplitRegExpr(RegExpr,InputStr,Pieces);
end;
function ps_ReplaceRegExpr( const RegExpr, InputStr, ReplaceStr : String; UseSubstitution : boolean) : String;extdecl;
begin
result := ReplaceRegExpr(RegExpr,InputStr,ReplaceStr,UseSubstitution);
end;
\ No newline at end of file
+function ps_Format(const fmt : string;const args : array of const) : string; extdecl;
begin;
Result := Format(fmt,Args);
end;
function ps_Capitalize(str : string) : string;extdecl;
begin
result := Capitalize(str);
end;
function ps_CompressString(const Str : string) : string; extdecl;
begin
result := CompressString(str);
end;
function ps_DecompressString(const Compressed : string) : string; extdecl;
begin
result := DecompressString(Compressed);
end;
function ps_Base64Encode(const str : string) : string; extdecl;
begin
result := Base64Encode(str);
end;
function ps_Base64Decode(const str : string) : string; extdecl;
begin
result := Base64Decode(str);
end;
function ps_ExtractFromStr( Str : string; Extract : StrExtr) : string; extdecl;
begin
result := extractfromstr(str,extract);
end;
function ps_BoolToStr(bool : boolean) : string; extdecl;
begin;
result := BoolToStr(bool,true);
end;
function ps_Replace(Text, FindStr, ReplaceStr: string; Flags: TReplaceFlags): string; extdecl;
begin;
result := StringReplace(Text,FindStr,ReplaceStr,Flags);
end;
function ps_IntToStr(int : integer) : string; extdecl;
begin
result := inttostr(int);
end;
function ps_FloatToStr(flt : extended) : string; extdecl;
begin
result := floattostr(flt);
end;
function ps_StrToInt(value: String): Integer; extdecl;
begin
result := StrToInt(value);
end;
function ps_StrToIntDef(value: String; default: Integer): Integer; extdecl;
begin
result := StrToIntDef(value,default);
end;
function ps_StrToFloat(value: String): Extended; extdecl;
begin
result := StrToFloat(value);
end;
function ps_StrToFloatDef(value: String; default: Extended): Extended; extdecl;
begin
result := StrToFloatDef(value,default);
end;
function ps_StrToBool(value: String): Boolean;extdecl;
begin
result := StrToBool(value);
end;
function ps_StrToBoolDef(value: String; default: Boolean): Boolean; extdecl;
begin
result := StrToBoolDef(value,default);
end;
function ps_Between(s1, s2, str: string): string; extdecl;
var
I,J : integer;
begin;
Result := '';
I := pos(s1,str);
if I > 0 then
begin;
i := i + length(s1);
j := posex(s2,str,i);
if j > 0 then
Result := copy(str,i,j-i);
end;
end;
function ps_Implode(Glue : string; Pieces: TStringArray): string;extdecl;
begin
result := implode(glue,pieces);
end;
function ps_Explode(del, str: string): TStringArray;extdecl;
begin
result := Explode(del,str);
end;
procedure ps_ExplodeWrap(del, str: string; var res : TStringArray);extdecl;
begin
res := Explode(del,str);
end;
function ps_Padl(s: String; i: longInt): String;extdecl;
begin
result := StringOfChar(Char(' '), i - length(s)) + s;
end;
function ps_Padz(s: String; i: longInt): String;extdecl;
begin
result := StringOfChar(Char('0'), i - length(s)) + s;
end;
function ps_Padr(s: String; i: longInt): String;extdecl;
begin
result := s + StringOfChar(Char(' '), i - Length(s));
end;
function ps_ExecRegExpr( const RegExpr, InputStr : String) : boolean;extdecl;
begin
result := execregexpr(RegExpr,InputStr);
end;
procedure ps_SplitRegExpr( const RegExpr, InputStr : String; Pieces : TStrings);extdecl;
begin
SplitRegExpr(RegExpr,InputStr,Pieces);
end;
function ps_ReplaceRegExpr( const RegExpr, InputStr, ReplaceStr : String; UseSubstitution : boolean) : String;extdecl;
begin
result := ReplaceRegExpr(RegExpr,InputStr,ReplaceStr,UseSubstitution);
end;
\ No newline at end of file
diff --git a/Units/MMLAddon/PSInc/Wrappers/tpa.inc b/Units/MMLAddon/PSInc/Wrappers/tpa.inc
index 8f58014..0c7c547 100644
--- a/Units/MMLAddon/PSInc/Wrappers/tpa.inc
+++ b/Units/MMLAddon/PSInc/Wrappers/tpa.inc
@@ -28,12 +28,12 @@ begin
RAaSTPA(a,dist);
end;
-function ps_NearbyPointInArrayEx(const P: TPoint; w, h:Integer; a: TPointArray): Boolean;extdecl;
+function ps_NearbyPointInArrayEx(const P: TPoint; w, h:Integer;const a: TPointArray): Boolean;extdecl;
begin
result := NearbyPointInArrayEx(p,w,h,a);
end;
-function ps_NearbyPointInArray(const P: TPoint; Dist:Integer; a: TPointArray): Boolean; extdecl;
+function ps_NearbyPointInArray(const P: TPoint; Dist:Integer;const a: TPointArray): Boolean; extdecl;
begin
result := NearbyPointInArray(p,dist,a);
end;
@@ -73,12 +73,12 @@ begin
InvertATPA(a);
end;
-function ps_MiddleTPAEx(TPA: TPointArray; var x, y: Integer): Boolean; extdecl;
+function ps_MiddleTPAEx(const TPA: TPointArray; var x, y: Integer): Boolean; extdecl;
begin
Result := MiddleTPAEx(tpa,x,y);
end;
-function ps_MiddleTPA(tpa: TPointArray): TPoint; extdecl;
+function ps_MiddleTPA(const tpa: TPointArray): TPoint; extdecl;
begin
result := MiddleTPA(tpa);
end;
@@ -93,12 +93,12 @@ begin
SortATPAFromSize(a,size,closefirst);
end;
-function ps_InIntArrayEx(a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;extdecl;
+function ps_InIntArrayEx(const a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;extdecl;
begin
result := InIntArrayEx(a,where,number);
end;
-function ps_InIntArray(a: TIntegerArray; Number: Integer): Boolean; extdecl;
+function ps_InIntArray(const a: TIntegerArray; Number: Integer): Boolean; extdecl;
begin
result := InIntArray(a,number);
end;
@@ -113,42 +113,57 @@ begin
ClearSameIntegersAndTPA(a,p);
end;
-function ps_SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray; extdecl;
+function ps_SplitTPAEx(const arr: TPointArray; w, h: Integer): T2DPointArray; extdecl;
begin
result := SplitTPAEx(arr,w,h);
end;
-function ps_SplitTPA(arr: TPointArray; Dist: Integer): T2DPointArray; extdecl;
+function ps_SplitTPA(const arr: TPointArray; Dist: Integer): T2DPointArray; extdecl;
begin
result := SplitTPA(arr,dist);
end;
+function ps_FloodFillTPA(const TPA : TPointArray) : T2DPointArray; extdecl;
+begin
+ result := FloodFillTPA(TPA);
+end;
+
procedure ps_FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);extdecl;
begin
FilterPointsPie(points,sd,ed,minr,maxr,mx,my);
end;
-function ps_GetATPABounds(ATPA: T2DPointArray): TBox;extdecl;
+procedure ps_FilterPointsDist(var Points: TPointArray; const MinDist, MaxDist: Extended; Mx, My: Integer); extdecl;
+begin
+ FilterPointsDist(points,mindist,maxdist,mx,my);
+end;
+
+procedure ps_FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);extdecl;
+begin
+ FilterPointsLine(points,radial,radius,mx,my);
+end;
+
+function ps_GetATPABounds(const ATPA: T2DPointArray): TBox;extdecl;
begin
result := GetATPABounds(ATPA);
end;
-function ps_GetTPABounds(TPA: TPointArray): TBox; extdecl;
+function ps_GetTPABounds(const TPA: TPointArray): TBox; extdecl;
begin
result := GetTPABounds(TPA);
end;
-function ps_FindTPAinTPA(SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; extdecl;
+function ps_FindTPAinTPA(const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; extdecl;
begin
Result := FindTPAinTPA(searchTPA,totaltpa,matches);
end;
-function ps_GetSamePointsATPA( ATPA : T2DPointArray; var Matches : TPointArray) : boolean;extdecl;
+function ps_GetSamePointsATPA(const ATPA : T2DPointArray; var Matches : TPointArray) : boolean;extdecl;
begin
result := GetSamePointsATPA(ATPA,Matches);
end;
-function ps_FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;extdecl;
+function ps_FindTextTPAinTPA(Height : integer;const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;extdecl;
begin
result := FindTextTPAinTPA(height,searchtpa,totaltpa,matches);
end;
@@ -168,51 +183,66 @@ begin
result := RotatePoint(p,angle,mx,my);
end;
-function ps_FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray; extdecl;
+function ps_ChangeDistPT(const PT : TPoint; mx,my : integer; newdist : extended) : TPoint;extdecl;
+begin
+ result := ChangeDistPT(pt,mx,my,newdist);
+end;
+
+function ps_ChangeDistTPA(var TPA : TPointArray; mx,my : integer; newdist : extended) : boolean; extdecl;
+begin
+ result := ChangeDistTPA(tpa,mx,my,newdist);
+end;
+
+function ps_FindGapsTPA(const TPA: TPointArray; MinPixels: Integer): T2DPointArray; extdecl;
begin
result := FindGapsTPA(TPA,minpixels);
end;
-function ps_RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray; extdecl;
+function ps_RemoveDistTPointArray(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray; extdecl;
begin
Result := RemoveDistTPointArray(x,y,dist,thepoints,removehigher);
end;
-function ps_CombineTPA(Ar1, Ar2: TPointArray): TPointArray; extdecl;
+function ps_CombineTPA(const Ar1, Ar2: TPointArray): TPointArray; extdecl;
begin
result := CombineTPA(ar1,ar2);
end;
-function ps_ReArrangeandShortenArrayEx(a: TPointArray; w, h: Integer): TPointArray;extdecl;
+function ps_ReArrangeandShortenArrayEx(const a: TPointArray; w, h: Integer): TPointArray;extdecl;
begin
result := ReArrangeandShortenArrayEx(a,w,h);
end;
-function ps_ReArrangeandShortenArray(a: TPointArray; Dist: Integer): TPointArray; extdecl;
+function ps_ReArrangeandShortenArray(const a: TPointArray; Dist: Integer): TPointArray; extdecl;
begin
result := ReArrangeandShortenArray(a,dist);
end;
-function ps_TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray; extdecl;
+function ps_TPAtoATPAEx(const TPA: TPointArray; w, h: Integer): T2DPointArray; extdecl;
begin
result := TPAtoATPAEx(tpa,w,h);
end;
-function ps_TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray;extdecl;
+function ps_TPAtoATPA(const TPA: TPointArray; Dist: Integer): T2DPointArray;extdecl;
begin
Result := TPAtoATPA(tpa,dist);
end;
-function ps_CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray; extdecl;
+function ps_CombineIntArray(const Ar1, Ar2: TIntegerArray): TIntegerArray; extdecl;
begin
result := CombineIntArray(ar1,ar2);
end;
-function ps_MergeATPA(ATPA : T2DPointArray) : TPointArray; extdecl;
+function ps_MergeATPA(const ATPA : T2DPointArray) : TPointArray; extdecl;
begin
result := MergeATPA(ATPA);
end;
+procedure ps_AppendTPA(var TPA: TPointArray; const ToAppend: TPointArray);
+begin
+ AppendTPA(tpa,ToAppend);
+end;
+
function ps_TPAFromBox(const Box : TBox) : TPointArray; extdecl;
begin
result := TPAFromBox(box);
@@ -223,12 +253,12 @@ begin
Result := RotatePoints(p,a,cx,cy);
end;
-function ps_FindTPAEdges(p: TPointArray): TPointArray;extdecl;
+function ps_FindTPAEdges(const p: TPointArray): TPointArray;extdecl;
begin
result := FindTPAEdges(p);
end;
-function ps_ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray; extdecl;
+function ps_ClearTPAFromTPA(const arP, ClearPoints: TPointArray): TPointArray; extdecl;
begin
result := ClearTPAFromTPA(arP,ClearPoints);
end;
@@ -238,7 +268,7 @@ begin
result := ReturnPointsNotInTPA(totaltpa,box);
end;
-function ps_PointInTPA(p: TPoint; arP: TPointArray): Boolean; extdecl;
+function ps_PointInTPA(p: TPoint;const arP: TPointArray): Boolean; extdecl;
begin
result := PointInTPA(p,arp);
end;
@@ -263,64 +293,64 @@ begin
InvertTIA(ti);
end;
-function ps_SumIntegerArray(Ints : TIntegerArray): Integer; extdecl;
+function ps_SumIntegerArray(const Ints : TIntegerArray): Integer; extdecl;
begin
result := SumIntegerArray(ints);
end;
-function ps_AverageTIA(tI: TIntegerArray): Integer; extdecl;
+function ps_AverageTIA(const tI: TIntegerArray): Integer; extdecl;
begin
result := AverageTIA(ti);
end;
-function ps_AverageExtended(tE: TExtendedArray): Extended; extdecl;
+function ps_AverageExtended(const tE: TExtendedArray): Extended; extdecl;
begin
result := AverageExtended(te);
end;
-procedure ps_SplitTPAExWrap(arr: TPointArray; w, h: Integer; var res : T2DPointArray);extdecl;
+procedure ps_SplitTPAExWrap(const arr: TPointArray; w, h: Integer; var res : T2DPointArray);extdecl;
begin
res := SplitTPAEx(arr,w,h);
end;
-procedure ps_SplitTPAWrap(arr: TPointArray; Dist: Integer; var res: T2DPointArray);extdecl;
+procedure ps_SplitTPAWrap(const arr: TPointArray; Dist: Integer; var res: T2DPointArray);extdecl;
begin
res := SplitTPA(arr,dist);
end;
-procedure ps_FindGapsTPAWrap(TPA: TPointArray; MinPixels: Integer; var Res : T2DPointArray); extdecl;
+procedure ps_FindGapsTPAWrap(const TPA: TPointArray; MinPixels: Integer; var Res : T2DPointArray); extdecl;
begin
Res := FindGapsTPA(TPA,MinPixels);
end;
-procedure ps_RemoveDistTPointArrayWrap(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean; var Res : TPointArray);extdecl;
+procedure ps_RemoveDistTPointArrayWrap(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean; var Res : TPointArray);extdecl;
begin
Res := RemoveDistTPointArray(x,y,dist,thepoints,removehigher);
end;
-procedure ps_CombineTPAWrap(Ar1, Ar2: TPointArray; var Res : TPointArray);extdecl;
+procedure ps_CombineTPAWrap(const Ar1, Ar2: TPointArray; var Res : TPointArray);extdecl;
begin
Res := CombineTPA(Ar1,Ar2);
end;
-procedure ps_ReArrangeandShortenArrayExWrap(a: TPointArray; w, h: Integer; var Res : TPointArray);extdecl;
+procedure ps_ReArrangeandShortenArrayExWrap(const a: TPointArray; w, h: Integer; var Res : TPointArray);extdecl;
begin
Res := ReArrangeandShortenArrayEx(a,w,h);
end;
-procedure ps_ReArrangeandShortenArrayWrap(a: TPointArray; Dist: Integer; var Res : TPointArray);extdecl;
+procedure ps_ReArrangeandShortenArrayWrap(const a: TPointArray; Dist: Integer; var Res : TPointArray);extdecl;
begin
Res := ReArrangeandShortenArray(a,dist);
end;
-procedure ps_TPAtoATPAExWrap(TPA: TPointArray; w, h: Integer; var Res : T2DPointArray);extdecl;
+procedure ps_TPAtoATPAExWrap(const TPA: TPointArray; w, h: Integer; var Res : T2DPointArray);extdecl;
begin
Res := TPAtoATPAEx(TPA,w,h);
end;
-procedure ps_TPAtoATPAWrap(TPA: TPointArray; Dist: Integer; var Res : T2DPointArray);extdecl;
+procedure ps_TPAtoATPAWrap(const TPA: TPointArray; Dist: Integer; var Res : T2DPointArray);extdecl;
begin
Res := TPAtoATPA(TPA,Dist);
end;
-procedure ps_CombineIntArrayWrap(Ar1, Ar2: TIntegerArray; var Res : TIntegerArray);extdecl;
+procedure ps_CombineIntArrayWrap(const Ar1, Ar2: TIntegerArray; var Res : TIntegerArray);extdecl;
begin
Res := CombineIntArray(Ar1,Ar2);
end;
-procedure ps_MergeATPAWrap(ATPA : T2DPointArray; var Res: TPointArray); extdecl;
+procedure ps_MergeATPAWrap(const ATPA : T2DPointArray; var Res: TPointArray); extdecl;
begin
Res := MergeATPA(ATPA);
end;
@@ -332,11 +362,11 @@ procedure ps_RotatePointsWrap(Const P: TPointArray; A, cx, cy: Extended; var Res
begin
Res := RotatePoints(P,a,cx,cy);
end;
-procedure ps_FindTPAEdgesWrap(p: TPointArray; var Res : TPointArray);extdecl;
+procedure ps_FindTPAEdgesWrap(const p: TPointArray; var Res : TPointArray);extdecl;
begin
Res := FindTPAEdges(p);
end;
-procedure ps_ClearTPAFromTPAWrap(arP, ClearPoints: TPointArray; var Res : TPointArray);extdecl;
+procedure ps_ClearTPAFromTPAWrap(const arP, ClearPoints: TPointArray; var Res : TPointArray);extdecl;
begin
Res := ClearTPAFromTPA(arP, clearpoints);
end;
@@ -345,17 +375,35 @@ begin
Res := ReturnPointsNotInTPA(TotalTPA,box);
end;
-procedure ps_FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);extdecl;
-begin
- FilterPointsLine(points,radial,radius,mx,my);
-end;
-
-function ps_SameTPA(aTPA, bTPA: TPointArray): Boolean;extdecl;
+function ps_SameTPA(const aTPA, bTPA: TPointArray): Boolean;extdecl;
begin
result := SameTPA(atpa,btpa);
end;
-function ps_TPAInATPA(TPA: TPointArray; InATPA: T2DPointArray; var Index: LongInt): Boolean;extdecl;
+function ps_TPAInATPA(const TPA: TPointArray;const InATPA: T2DPointArray; var Index: LongInt): Boolean;extdecl;
begin
result := TPAInATPA(tpa,inatpa,index);
end;
+procedure ps_OffsetTPA(var TPA : TPointArray; const Offset : TPoint); extdecl;
+begin
+ OffsetTPA(TPA,offset);
+end;
+
+procedure ps_OffsetATPA(var ATPA : T2DPointArray; const Offset : TPoint);extdecl;
+begin
+ OffsetATPA(atpa,offset);
+end;
+function ps_CopyTPA(const TPA : TPointArray) : TPointArray;extdecl;
+begin
+ result := Copy(TPA,0,Length(TPA));
+end;
+
+function ps_CopyATPA(const ATPA : T2DPointArray) : T2DPointArray; extdecl;
+var
+ i,l : integer;
+begin
+ l := high(ATPA);
+ SetLength(result,l+1);
+ for i := 0 to l do
+ result[i] := copy(ATPA[i],0,Length(ATPA[i]));
+end;
diff --git a/Units/MMLAddon/PSInc/pscompile.inc b/Units/MMLAddon/PSInc/pscompile.inc
index 074d56d..cdf20ed 100644
--- a/Units/MMLAddon/PSInc/pscompile.inc
+++ b/Units/MMLAddon/PSInc/pscompile.inc
@@ -26,6 +26,8 @@ x.AddConstantN('ScriptPath','string').SetString(Self.ScriptPath);
x.AddConstantN('IncludePath','string').SetString(Self.IncludePath);
x.AddConstantN('PluginPath','string').SetString(Self.PluginPath);
x.AddConstantN('FontPath','string').SetString(Self.FontPath);
+x.AddConstantN('MaxLongInt','integer').SetInt(maxLongint);
+x.AddConstantN('MaxInt','integer').SetInt(maxLongint);
x.AddTypeS('TReplaceFlag', '(rfReplaceAll, rfIgnoreCase)');
x.AddTypeS('TReplaceFlags','set of TReplaceFlag');
x.AddTypeS('StrExtr','(Numbers, Letters, Others);');
diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc
index 2d74711..4aa7a99 100644
--- a/Units/MMLAddon/PSInc/psexportedmethods.inc
+++ b/Units/MMLAddon/PSInc/psexportedmethods.inc
@@ -23,6 +23,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
+AddFunction(@ps_debugln,'procedure DebugLn(str : string);');
{ DTM }
@@ -54,7 +55,7 @@ AddFunction(@ps_min,'function Min(a, b: Integer): Integer;');
AddFunction(@ps_minE,'function MinE(a, b: extended): Extended;');
AddFunction(@ps_maxE,'function MaxE(a, b: extended): Extended;');
AddFunction(@ps_iAbs,'function iAbs(a : integer) : integer;');
-AddFunction(@ps_ArcTan2,'function ArcTan2(x,y : extended) : extended;');
+AddFunction(@ps_ArcTan2,'function ArcTan2(y,x : extended) : extended;');
AddFunction(@ps_IntToBox,'function IntToBox(xs,ys,xe,ye : integer) : TBox;');
AddFunction(@ps_IntInBox,'function IntInBox(x, y: Integer; Box: TBox): Boolean;');
AddFunction(@ps_PointToBox,'function PointToBox(PT1,PT2 : TPoint): TBox;');
@@ -73,7 +74,9 @@ AddFunction(@ps_logn,'function logn(base, x : extended): extended;');
AddFunction(@ps_ln,'function ln(x : extended) : extended;');
AddFunction(@ps_inttohex,'function IntToHex(number : integer) : string');
AddFunction(@ps_hextoint,'function HexToInt(Hex : string) : integer');
-
+AddFunction(@ps_sar,'function sar(AValue : longint; shift : byte) : longint;');
+AddFunction(@ps_ror,'function ror(num : longword; shift : byte) : LongWord;');
+AddFunction(@ps_rol,'function rol(num : longword; shift : byte) : LongWord;');
{window}
SetCurrSection('Window');
AddFunction(@ps_Freeze, 'function Freeze: boolean;');
@@ -108,6 +111,9 @@ AddFunction(@ps_FilePointerPos, 'function FilePointerPos(FileNum: Integer): Inte
AddFunction(@ps_DirectoryExists,'function DirectoryExists(const DirectoryName : string ) : Boolean;');
AddFunction(@ps_CreateDirectory,'function CreateDirectory(const DirectoryName : string) : boolean;');
AddFunction(@ps_FileExists,'function FileExists (const FileName : string ) : Boolean;');
+AddFunction(@ps_ForceDirectores,'function ForceDirectores(const dir : string) : boolean;');
+AddFunction(@ps_GetFiles,'function GetFiles(const Path, Ext : string) : TStringArray;');
+AddFunction(@ps_GetDirectories,'function GetDirectories(const path : string) : TStringArray;');
AddFunction(@ps_WriteINI,'procedure WriteINI(const Section, KeyName, NewString, FileName: string);');
AddFunction(@ps_ReadINI,'function ReadINI(const Section, KeyName, FileName: string): string;');
AddFunction(@ps_DeleteINI,'procedure DeleteINI(const Section, KeyName, FileName: string);');
@@ -128,6 +134,7 @@ AddFunction(@ps_DecodeTime,'procedure DecodeTime(DateTime : TDateTime; var Hour,
AddFunction(@ps_DecodeDate,'procedure DecodeDate ( const SourceDate : TDateTime; var Year, Month, Day : Word );');
AddFunction(@ps_ConvertTime,'procedure ConvertTime(Time: integer; var h, m, s: integer);');
AddFunction(@ps_HakunaMatata,'procedure HakunaMatata;');
+AddFunction(@ps_Simba,'procedure Simba;');
AddFunction(@ps_TerminateScript,'procedure TerminateScript;');
AddFunction(@ps_DisplayDebugImgWindow,'procedure DisplayDebugImgWindow(w, h: integer);');
AddFunction(@ps_DrawBitmapDebugImg,'procedure DrawBitmapDebugImg(bmp: integer);');
@@ -143,6 +150,10 @@ AddFunction(@ps_InputQuery,'function InputQuery(const ACaption, APrompt : String
{string}
SetCurrSection('String');
AddFunction(@ps_Capitalize,'function Capitalize(str : string) : string;');
+AddFunction(@ps_CompressString,'function CompressString(const Str : string) : string;');
+AddFunction(@ps_DecompressString,'function DecompressString(const Compressed : string) : string;');
+AddFunction(@ps_Base64Encode,'function Base64Encode(const str : string) : string;');
+AddFunction(@ps_Base64Decode,'function Base64Decode(const str : string) : string;');
AddFunction(@ps_Format,'function Format(const fmt : string;const args : array of const) : string;');
AddFunction(nil,'function ToStr(x) : string;');
AddFunction(@ps_Between,'function Between(s1, s2, str: string): string;');
@@ -318,8 +329,8 @@ AddFunction(@ps_tpaSwap,'procedure tpaSwap(var a, b: TPointArray);');
AddFunction(@ps_SwapE,'procedure SwapE(var a, b: Extended);');
AddFunction(@ps_RAaSTPAEx,'procedure RAaSTPAEx(var a: TPointArray; const w, h: Integer);');
AddFunction(@ps_RAaSTPA,'procedure RAaSTPA(var a: TPointArray; const Dist: Integer);');
-AddFunction(@ps_NearbyPointInArrayEx,'function NearbyPointInArrayEx(const P: TPoint; w, h:Integer; a: TPointArray): Boolean;');
-AddFunction(@ps_NearbyPointInArray,'function NearbyPointInArray(const P: TPoint; Dist:Integer; a: TPointArray): Boolean;');
+AddFunction(@ps_NearbyPointInArrayEx,'function NearbyPointInArrayEx(const P: TPoint; w, h:Integer;const a: TPointArray): Boolean;');
+AddFunction(@ps_NearbyPointInArray,'function NearbyPointInArray(const P: TPoint; Dist:Integer;const a: TPointArray): Boolean;');
AddFunction(@ps_QuickTPASort,'procedure QuickTPASort(var A: TIntegerArray; var B: TPointArray; iLo, iHi: Integer; SortUp: Boolean);');
AddFunction(@ps_QuickATPASort,'procedure QuickATPASort(var A: TIntegerArray; var B: T2DPointArray; iLo, iHi: Integer; SortUp: Boolean);');
AddFunction(@ps_SortTPAFrom,'procedure SortTPAFrom(var a: TPointArray; const From: TPoint);');
@@ -327,66 +338,75 @@ AddFunction(@ps_SortATPAFrom,'procedure SortATPAFrom(var a: T2DPointArray; const
AddFunction(@ps_SortATPAFromFirstPoint,'procedure SortATPAFromFirstPoint(var a: T2DPointArray; const From: TPoint);');
AddFunction(@ps_InvertTPA,'procedure InvertTPA(var a: TPointArray);');
AddFunction(@ps_InvertATPA,'procedure InvertATPA(var a: T2DPointArray);');
-AddFunction(@ps_MiddleTPAEx,'function MiddleTPAEx(TPA: TPointArray; var x, y: Integer): Boolean;');
-AddFunction(@ps_MiddleTPA,'function MiddleTPA(tpa: TPointArray): TPoint;');
+AddFunction(@ps_MiddleTPAEx,'function MiddleTPAEx(const TPA: TPointArray; var x, y: Integer): Boolean;');
+AddFunction(@ps_MiddleTPA,'function MiddleTPA(const tpa: TPointArray): TPoint;');
AddFunction(@ps_SortATPASize,'procedure SortATPASize(var a: T2DPointArray; const BigFirst: Boolean);');
AddFunction(@ps_SortATPAFromSize,'procedure SortATPAFromSize(var a: T2DPointArray; const Size: Integer; CloseFirst: Boolean);');
-AddFunction(@ps_InIntArrayEx,'function InIntArrayEx(a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;');
-AddFunction(@ps_InIntArray,'function InIntArray(a: TIntegerArray; Number: Integer): Boolean;');
+AddFunction(@ps_InIntArrayEx,'function InIntArrayEx(const a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;');
+AddFunction(@ps_InIntArray,'function InIntArray(const a: TIntegerArray; Number: Integer): Boolean;');
AddFunction(@ps_ClearSameIntegers,'procedure ClearSameIntegers(var a: TIntegerArray);');
AddFunction(@ps_ClearSameIntegersAndTPA,'procedure ClearSameIntegersAndTPA(var a: TIntegerArray; var p: TPointArray);');
-AddFunction(@ps_SplitTPAEx,'function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;');
-AddFunction(@ps_SplitTPA,'function SplitTPA(arr: TPointArray; Dist: Integer): T2DPointArray;');
+AddFunction(@ps_SplitTPAEx,'function SplitTPAEx(const arr: TPointArray; w, h: Integer): T2DPointArray;');
+AddFunction(@ps_SplitTPA,'function SplitTPA(const arr: TPointArray; Dist: Integer): T2DPointArray;');
+AddFunction(@ps_FloodFillTPA,'function FloodFillTPA(const TPA : TPointArray) : T2DPointArray;');
AddFunction(@ps_FilterPointsPie,'procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);');
-AddFunction(@ps_GetATPABounds,'function GetATPABounds(ATPA: T2DPointArray): TBox;');
-AddFunction(@ps_GetTPABounds,'function GetTPABounds(TPA: TPointArray): TBox;');
-AddFunction(@ps_FindTPAinTPA,'function FindTPAinTPA(SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;');
-AddFunction(@ps_GetSamePointsATPA,'function GetSamePointsATPA( ATPA : T2DPointArray; var Matches : TPointArray) : boolean;');
-AddFunction(@ps_FindTextTPAinTPA,'function FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;');
+AddFunction(@ps_FilterPointsLine,'procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);');
+AddFunction(@ps_filterpointsdist,'procedure FilterPointsDist(var Points: TPointArray; const MinDist, MaxDist: Extended; Mx, My: Integer);');
+AddFunction(@ps_GetATPABounds,'function GetATPABounds(const ATPA: T2DPointArray): TBox;');
+AddFunction(@ps_GetTPABounds,'function GetTPABounds(const TPA: TPointArray): TBox;');
+AddFunction(@ps_FindTPAinTPA,'function FindTPAinTPA(const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;');
+AddFunction(@ps_GetSamePointsATPA,'function GetSamePointsATPA(const ATPA : T2DPointArray; var Matches : TPointArray) : boolean;');
+AddFunction(@ps_FindTextTPAinTPA,'function FindTextTPAinTPA(Height : integer;const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;');
AddFunction(@ps_SortCircleWise,'procedure SortCircleWise(var tpa: TPointArray; const cx, cy, StartDegree: Integer; SortUp, ClockWise: Boolean);');
AddFunction(@ps_LinearSort,'procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean);');
AddFunction(@ps_RotatePoint,'function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint;');
-AddFunction(@ps_FindGapsTPA,'function FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray;');
-AddFunction(@ps_RemoveDistTPointArray,'function RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;');
-AddFunction(@ps_CombineTPA,'function CombineTPA(Ar1, Ar2: TPointArray): TPointArray;');
-AddFunction(@ps_ReArrangeandShortenArrayEx,'function ReArrangeandShortenArrayEx(a: TPointArray; w, h: Integer): TPointArray;');
-AddFunction(@ps_ReArrangeandShortenArray,'function ReArrangeandShortenArray(a: TPointArray; Dist: Integer): TPointArray;');
-AddFunction(@ps_TPAtoATPAEx,'function TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray;');
-AddFunction(@ps_TPAtoATPA,'function TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray;');
-AddFunction(@ps_CombineIntArray,'function CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray;');
-AddFunction(@ps_MergeATPA,'function MergeATPA(ATPA : T2DPointArray) : TPointArray;');
+AddFunction(@ps_ChangeDistPT,'function ChangeDistPT(const PT : TPoint; mx,my : integer; newdist : extended) : TPoint;');
+AddFunction(@ps_ChangeDistTPA,'function ChangeDistTPA(var TPA : TPointArray; mx,my : integer; newdist : extended) : boolean;');
+AddFunction(@ps_FindGapsTPA,'function FindGapsTPA(const TPA: TPointArray; MinPixels: Integer): T2DPointArray;');
+AddFunction(@ps_RemoveDistTPointArray,'function RemoveDistTPointArray(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;');
+AddFunction(@ps_CombineTPA,'function CombineTPA(const Ar1, Ar2: TPointArray): TPointArray;');
+AddFunction(@ps_ReArrangeandShortenArrayEx,'function ReArrangeandShortenArrayEx(const a: TPointArray; w, h: Integer): TPointArray;');
+AddFunction(@ps_ReArrangeandShortenArray,'function ReArrangeandShortenArray(const a: TPointArray; Dist: Integer): TPointArray;');
+AddFunction(@ps_TPAtoATPAEx,'function TPAtoATPAEx(const TPA: TPointArray; w, h: Integer): T2DPointArray;');
+AddFunction(@ps_TPAtoATPA,'function TPAtoATPA(const TPA: TPointArray; Dist: Integer): T2DPointArray;');
+AddFunction(@ps_CombineIntArray,'function CombineIntArray(const Ar1, Ar2: TIntegerArray): TIntegerArray;');
+AddFunction(@ps_MergeATPA,'function MergeATPA(const ATPA : T2DPointArray) : TPointArray;');
+AddFunction(@ps_AppendTPA,'procedure AppendTPA(var TPA: TPointArray; const ToAppend: TPointArray);');
AddFunction(@ps_TPAFromBox,'function TPAFromBox(const Box : TBox) : TPointArray;');
AddFunction(@ps_RotatePoints,'function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ;');
-AddFunction(@ps_FindTPAEdges,'function FindTPAEdges(p: TPointArray): TPointArray;');
-AddFunction(@ps_ClearTPAFromTPA,'function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray;');
+AddFunction(@ps_FindTPAEdges,'function FindTPAEdges(const p: TPointArray): TPointArray;');
+AddFunction(@ps_ClearTPAFromTPA,'function ClearTPAFromTPA(const arP, ClearPoints: TPointArray): TPointArray;');
AddFunction(@ps_ReturnPointsNotInTPA,'function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; const Box: TBox): TPointArray;');
-AddFunction(@ps_PointInTPA,'function PointInTPA(p: TPoint; arP: TPointArray): Boolean;');
+AddFunction(@ps_PointInTPA,'function PointInTPA(p: TPoint;const arP: TPointArray): Boolean;');
AddFunction(@ps_ClearDoubleTPA,'procedure ClearDoubleTPA(var TPA: TPointArray);');
AddFunction(@ps_TPACountSort,'procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean);');
AddFunction(@ps_TPACountSortBase,'procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean);');
AddFunction(@ps_InvertTIA,'procedure InvertTIA(var tI: TIntegerArray);');
-AddFunction(@ps_SumIntegerArray,'function SumIntegerArray(Ints : TIntegerArray): Integer;');
-AddFunction(@ps_AverageTIA,'function AverageTIA(tI: TIntegerArray): Integer;');
-AddFunction(@ps_AverageExtended,'function AverageExtended(tE: TExtendedArray): Extended;');
-AddFunction(@ps_SplitTPAExWrap,'procedure SplitTPAExWrap(arr: TPointArray; w, h: Integer; var res : T2DPointArray);');
-AddFunction(@ps_SplitTPAWrap,'procedure SplitTPAWrap(arr: TPointArray; Dist: Integer; var res: T2DPointArray);');
-AddFunction(@ps_FindGapsTPAWrap,'procedure FindGapsTPAWrap(TPA: TPointArray; MinPixels: Integer; var Res : T2DPointArray);');
-AddFunction(@ps_RemoveDistTPointArrayWrap,'procedure RemoveDistTPointArrayWrap(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean; var Res : TPointArray);');
-AddFunction(@ps_CombineTPAWrap,'procedure CombineTPAWrap(Ar1, Ar2: TPointArray; var Res : TPointArray);');
-AddFunction(@ps_ReArrangeandShortenArrayExWrap,'procedure ReArrangeandShortenArrayExWrap(a: TPointArray; w, h: Integer; var Res : TPointArray);');
-AddFunction(@ps_ReArrangeandShortenArrayWrap,'procedure ReArrangeandShortenArrayWrap(a: TPointArray; Dist: Integer; var Res : TPointArray);');
-AddFunction(@ps_TPAtoATPAExWrap,'procedure TPAtoATPAExWrap(TPA: TPointArray; w, h: Integer; var Res : T2DPointArray);');
-AddFunction(@ps_TPAtoATPAWrap,'procedure TPAtoATPAWrap(TPA: TPointArray; Dist: Integer; var Res : T2DPointArray);');
-AddFunction(@ps_CombineIntArrayWrap, 'procedure CombineIntArrayWrap(Ar1, Ar2: TIntegerArray; var Res : TIntegerArray);');
+AddFunction(@ps_SumIntegerArray,'function SumIntegerArray(const Ints : TIntegerArray): Integer;');
+AddFunction(@ps_AverageTIA,'function AverageTIA(const tI: TIntegerArray): Integer;');
+AddFunction(@ps_AverageExtended,'function AverageExtended(const tE: TExtendedArray): Extended;');
+AddFunction(@ps_SplitTPAExWrap,'procedure SplitTPAExWrap(const arr: TPointArray; w, h: Integer; var res : T2DPointArray);');
+AddFunction(@ps_SplitTPAWrap,'procedure SplitTPAWrap(const arr: TPointArray; Dist: Integer; var res: T2DPointArray);');
+AddFunction(@ps_FindGapsTPAWrap,'procedure FindGapsTPAWrap(const TPA: TPointArray; MinPixels: Integer; var Res : T2DPointArray);');
+AddFunction(@ps_RemoveDistTPointArrayWrap,'procedure RemoveDistTPointArrayWrap(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean; var Res : TPointArray);');
+AddFunction(@ps_CombineTPAWrap,'procedure CombineTPAWrap(const Ar1, Ar2: TPointArray; var Res : TPointArray);');
+AddFunction(@ps_ReArrangeandShortenArrayExWrap,'procedure ReArrangeandShortenArrayExWrap(const a: TPointArray; w, h: Integer; var Res : TPointArray);');
+AddFunction(@ps_ReArrangeandShortenArrayWrap,'procedure ReArrangeandShortenArrayWrap(const a: TPointArray; Dist: Integer; var Res : TPointArray);');
+AddFunction(@ps_TPAtoATPAExWrap,'procedure TPAtoATPAExWrap(const TPA: TPointArray; w, h: Integer; var Res : T2DPointArray);');
+AddFunction(@ps_TPAtoATPAWrap,'procedure TPAtoATPAWrap(const TPA: TPointArray; Dist: Integer; var Res : T2DPointArray);');
+AddFunction(@ps_CombineIntArrayWrap, 'procedure CombineIntArrayWrap(const Ar1, Ar2: TIntegerArray; var Res : TIntegerArray);');
AddFunction(@ps_ReturnPointsNotInTPAWrap,'procedure ReturnPointsNotInTPAWrap(Const TotalTPA: TPointArray; const Box: TBox; var Res : TPointArray);');
-AddFunction(@ps_MergeATPAWrap,'procedure MergeATPAWrap(ATPA : T2DPointArray; var Res: TPointArray);');
+AddFunction(@ps_MergeATPAWrap,'procedure MergeATPAWrap(const ATPA : T2DPointArray; var Res: TPointArray);');
AddFunction(@ps_TPAFromBoxWrap,'procedure TPAFromBoxWrap(const Box : TBox; var Res : TPointArray);');
AddFunction(@ps_RotatePointsWrap,'procedure RotatePointsWrap(Const P: TPointArray; A, cx, cy: Extended; var Res : TPointArray);');
-AddFunction(@ps_FindTPAEdgesWrap,'procedure FindTPAEdgesWrap(p: TPointArray; var Res : TPointArray);');
-AddFunction(@ps_ClearTPAFromTPAWrap,'procedure ClearTPAFromTPAWrap(arP, ClearPoints: TPointArray; var Res : TPointArray);');
-AddFunction(@ps_FilterPointsLine,'procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);');
-AddFunction(@ps_SameTPA,'function SameTPA(aTPA, bTPA: TPointArray): Boolean;');
-AddFunction(@ps_TPAInATPA,'function TPAInATPA(TPA: TPointArray; InATPA: T2DPointArray; var Index: LongInt): Boolean;');
+AddFunction(@ps_FindTPAEdgesWrap,'procedure FindTPAEdgesWrap(const p: TPointArray; var Res : TPointArray);');
+AddFunction(@ps_ClearTPAFromTPAWrap,'procedure ClearTPAFromTPAWrap(const arP, ClearPoints: TPointArray; var Res : TPointArray);');
+AddFunction(@ps_SameTPA,'function SameTPA(const aTPA, bTPA: TPointArray): Boolean;');
+AddFunction(@ps_TPAInATPA,'function TPAInATPA(const TPA: TPointArray;const InATPA: T2DPointArray; var Index: LongInt): Boolean;');
+AddFunction(@ps_offsetTPA,'procedure OffsetTPA(var TPA : TPointArray; const Offset : TPoint);');
+AddFunction(@ps_offsetATPA,'procedure OffsetATPA(var ATPA : T2DPointArray; const Offset : TPoint);');
+AddFunction(@ps_copyTPA,'function CopyTPA(const TPA : TPointArray) : TPointArray;');
+AddFunction(@ps_CopyATPA,'function CopyATPA(const ATPA : T2DPointArray) : T2DPointArray;');
SetCurrSection('Settings');
AddFunction(@ps_KeyIsSetting, 'function KeyIsSetting(const KeyName: String): Boolean;');
diff --git a/Units/MMLAddon/mmisc.pas b/Units/MMLAddon/mmisc.pas
index 9de7167..2cf83c8 100644
--- a/Units/MMLAddon/mmisc.pas
+++ b/Units/MMLAddon/mmisc.pas
@@ -106,7 +106,9 @@ end;
function UnTar(const Input: TStream; const outputdir: string; overwrite: boolean): boolean; overload;
var
Tar : TTarArchive;
+ Succ : boolean;
DirRec : TTarDirRec;
+ FS : TFileStream;
begin;
result := false;
if not DirectoryExists(outputdir) then
@@ -114,23 +116,33 @@ begin;
exit;
Tar := TTarArchive.Create(input);
Tar.reset;
+ Succ := True;
while Tar.FindNext(DirRec) do
begin
if (DirRec.FileType = ftDirectory) then
begin;
if not DirectoryExists(outputdir + DirRec.Name) and not CreateDir(outputdir + DirRec.Name) then
- exit
+ begin
+ Succ := false;
+ break;
+ end;
end else if (DirRec.FileType = ftNormal) then
begin;
if FileExists(outputdir + dirrec.name) and not overwrite then
continue;
- Tar.ReadFile(outputdir + dirrec.name);
+ try
+ FS := TFileStream.Create(outputdir +dirrec.name,fmCreate);
+ tar.ReadFile(fs);
+ FS.Free;
+ except
+ Succ := false;
+ break;
+ end;
end else
mDebugLn(format('Unknown filetype in archive. %s',[dirrec.name]));
end;
Tar.Free;
- Result := true;
-
+ Result := Succ;
end;
constructor TProcThread.Create;
diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas
index 8382318..754d440 100644
--- a/Units/MMLAddon/mmlpsthread.pas
+++ b/Units/MMLAddon/mmlpsthread.pas
@@ -218,6 +218,7 @@ uses
uPSR_extctrls, //Runtime-libs
Graphics, //For Graphics types
math, //Maths!
+ mmath, //Real maths!
strutils,
tpa, //Tpa stuff
forms,//Forms
@@ -247,6 +248,13 @@ begin
mDebugLn(str);
end;
+procedure ps_DebugLn(str : string); extdecl;
+begin
+ if CurrThread.Prop.WriteTimeStamp then
+ str := format('[%s]: %s', [TimeToStr(TimeStampToDateTime(MSecsToTimeStamp(GetTickCount - CurrThread.StartTime))), str]);
+ mDebugLn(str);
+end;
+
function MakeString(data : TPSVariantIFC) : string;
begin;
if data.Dta = nil then
@@ -675,7 +683,7 @@ begin
RegisterMethod('procedure Contrast(TargetBitmap : TMufasaBitmap; co : Extended);');
RegisterMethod('procedure Invert(TargetBitmap : TMufasaBitmap);');
RegisterMethod('procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);');
- RegisterMethod('function Copy: TMufasaBitmap;');
+ RegisterMethod('function Copy(const xs,ys,xe,ye : integer) : TMufasaBitmap;');
RegisterMethod('function ToString : string;');
RegisterMethod('function CreateTMask : TMask;');
RegisterMethod('constructor create');
@@ -742,6 +750,12 @@ begin;
CurrThread.Client.MBitmaps.FreeBMP(Self.Index);
end;
+function TMufasaBitmapCopy(Self : TMufasaBitmap;const xs,ys,xe,ye : integer) : TMufasaBitmap;
+begin
+ result := Self.Copy(xs,ys,xe,ye);
+ CurrThread.Client.MBitmaps.AddBMP(result);
+end;
+
type
TRegExp = class(SynRegExpr.TRegExpr);
procedure MBmp_Index_r(self : TMufasaBitmap; var Index : integer);begin; Index := self.Index; end;
@@ -819,7 +833,7 @@ begin;
RegisterMethod(@TMufasaBitmap.Contrast,'CONTRAST');
RegisterMethod(@TMufasaBitmap.Invert,'INVERT');
RegisterMethod(@TMufasaBitmap.Posterize,'POSTERIZE');
- RegisterMethod(@TMufasaBitmap.Copy, 'COPY');
+ RegisterMethod(@TMufasaBitmapCopy, 'COPY');
RegisterMethod(@TMufasaBitmap.ToString,'TOSTRING');
RegisterMethod(@TMufasaBitmap.CreateTMask,'CREATETMASK');
RegisterPropertyHelper(@MBmp_TransColorSet_r,nil,'TRANSPARENTCOLORSET');
diff --git a/Units/MMLAddon/stringutil.pas b/Units/MMLAddon/stringutil.pas
index ae1d92e..78d986f 100644
--- a/Units/MMLAddon/stringutil.pas
+++ b/Units/MMLAddon/stringutil.pas
@@ -13,8 +13,14 @@ function ExtractFromStr( Str : string; Extract : StrExtr) : string;
function Capitalize(str : string) : string;
function Implode(Glue : string; Pieces: TStringArray): string;
function Explode(del, str: string): TStringArray;
+function CompressString(const Str : string) : string;
+function DecompressString(const Compressed : string) : string;
+function Base64Encode(const str : string) : string;
+function Base64Decode(const str : string) : string;
implementation
+uses
+ paszlib, DCPbase64;
function Implode(Glue: string;Pieces: TStringArray): string;
var
@@ -76,6 +82,53 @@ begin;
result[lenres-1] := Copy(str,lastpos,lenstr - lastpos + 1);
end;
+function CompressString(const Str: string): string;
+var
+ Destlen:longword;
+begin
+ result := '';
+ Destlen :=BufferLen;
+ if length(str) < 1 then
+ exit;
+ if compress(BufferString,destlen,PChar(Str),length(str)) = Z_OK then
+ begin
+ setlength(result,Destlen + 4);
+ PInteger(@result[1])^ := Length(str);
+ Move(bufferstring[0],result[5],Destlen);
+ end;
+end;
+
+function DecompressString(const Compressed: string): string;
+var
+ destlen : Longword;
+ len,dest : integer;
+ Compress : PChar;
+begin
+ result := '';
+ len := Length(Compressed);
+ Compress := PChar(Compressed);
+ if len < 5 then
+ exit;
+ dest := PInteger(@compress[0])^;
+ Inc(Compress,sizeof(integer));
+ if dest < 1 then
+ exit;
+ destlen := dest;
+ setlength(result,destlen);
+ if uncompress(PChar(result),destlen,Compress,len) <> z_OK then
+ result := '';
+end;
+
+function Base64Encode(const str: string): string;
+begin
+ result := Base64EncodeStr(str);
+end;
+
+function Base64Decode(const str: string): string;
+begin
+ result := Base64DecodeStr(str);
+end;
+
function Capitalize(str : string) : string;
var
i , l : integer;
diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas
index 52da0b3..ed416fc 100644
--- a/Units/MMLCore/bitmaps.pas
+++ b/Units/MMLCore/bitmaps.pas
@@ -24,7 +24,7 @@
unit bitmaps;
{$mode objfpc}{$H+}
-
+{$Inline on}
interface
uses
Classes, SysUtils, FPImage,IntfGraphics,graphtype,MufasaTypes,MufasaBase,graphics;
@@ -82,8 +82,8 @@ type
procedure Invert;overload;
procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);overload;
procedure Posterize(Po : integer);overload;
- function Copy: TMufasaBitmap;overload;
function Copy(const xs,ys,xe,ye : integer) : TMufasaBitmap; overload;
+ function Copy: TMufasaBitmap;overload;
function ToTBitmap: TBitmap;
function ToString : string;
procedure LoadFromTBitmap(bmp: TBitmap);
@@ -173,7 +173,7 @@ begin
Bmp1.ValidatePoint(comparebox.x1,comparebox.y1);
Bmp1.ValidatePoint(comparebox.x2,comparebox.y2);
Bmp2.ValidatePoint(comparebox.x1,comparebox.y1);
- Bmp2.ValidatePoint(comparebox.x1,comparebox.y1);
+ Bmp2.ValidatePoint(comparebox.x2,comparebox.y2);
Bmp1.SetAlphaValue(0);
Bmp2.SetAlphaValue(0);
w1 := bmp1.Width;
@@ -542,7 +542,7 @@ var
SIndex : Integer;
CurrX,CurrY : integer;
Search,Replace : LongWord;
-procedure AddToStack(x,y : integer);
+procedure AddToStack(x,y : integer);inline;
begin
if LongWord(FData[y * w + x]) = Search then
begin
@@ -595,7 +595,7 @@ begin
Result := TMufasaBitmap.Create;
Result.SetSize(xe-xs+1, ye-ys+1);
for i := ys to ye do
- Move(self.FData[i * self.w + xs], Result.FData[i-ys],result.Width * SizeOf(TRGB32));
+ Move(self.FData[i * self.w + xs], Result.FData[(i-ys) * result.w],result.Width * SizeOf(TRGB32));
end;
function TMufasaBitmap.ToTBitmap: TBitmap;
@@ -625,7 +625,7 @@ begin
CorrectData[i].B := FData[i].B;
end;
DestLen := BufferLen;
- if compress(Pchar(BufferString),destlen,PChar(DataStr),w*h*3) = Z_OK then
+ if compress(BufferString,destlen,PChar(DataStr),w*h*3) = Z_OK then
begin;
SetLength(DataStr,DestLen);
move(bufferstring[0],dataStr[1],DestLen);
diff --git a/Units/MMLCore/colour_conv.pas b/Units/MMLCore/colour_conv.pas
index dea8709..ef54a80 100644
--- a/Units/MMLCore/colour_conv.pas
+++ b/Units/MMLCore/colour_conv.pas
@@ -24,6 +24,7 @@
unit colour_conv;
{$mode objfpc}{$H+}
+{$Inline on}
interface
diff --git a/Units/MMLCore/files.pas b/Units/MMLCore/files.pas
index 21d7224..3596151 100644
--- a/Units/MMLCore/files.pas
+++ b/Units/MMLCore/files.pas
@@ -82,6 +82,8 @@ begin
if FindFirst(Path + '*.' + ext, faAnyFile, SearchRec) = 0 then
begin
repeat
+ if (SearchRec.Attr and faDirectory) = faDirectory then
+ Continue;
inc(c);
SetLength(Result,c);
Result[c-1] := SearchRec.Name;
@@ -99,7 +101,7 @@ begin
if FindFirst(Path + '*', faDirectory, SearchRec) = 0 then
begin
repeat
- if SearchRec.Name[1] = '.' then
+ if (SearchRec.Name[1] = '.') or ((SearchRec.Attr and faDirectory) <> faDirectory) then
continue;
inc(c);
SetLength(Result,c);
diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas
index f20cb1e..da8d65a 100644
--- a/Units/MMLCore/finder.pas
+++ b/Units/MMLCore/finder.pas
@@ -104,6 +104,7 @@ uses
// colour_conv,// For RGBToColor, etc.
Client, // For the Client Casts.
math, //min/max
+ mmath,
tpa, //TPABounds
dtmutil
;
diff --git a/Units/MMLCore/libloader.pas b/Units/MMLCore/libloader.pas
index 1220a5f..a535089 100644
--- a/Units/MMLCore/libloader.pas
+++ b/Units/MMLCore/libloader.pas
@@ -36,7 +36,7 @@ interface
implementation
uses
- MufasaTypes,MufasaBase,FileUtil;
+ MufasaTypes,MufasaBase,FileUtil, strutils;
procedure TGenericLoader.AddPath(path: string);
var
@@ -101,6 +101,8 @@ implementation
function TGenericLoader.VerifyPath(Path: string): string;
begin
+ if (@path = nil) or (path = '') then
+ exit('');
Result := Path;
if (Result[Length(Result)] <> DS) then
begin;
diff --git a/Units/MMLCore/mmath.pas b/Units/MMLCore/mmath.pas
index 941eea5..a34a2f8 100644
--- a/Units/MMLCore/mmath.pas
+++ b/Units/MMLCore/mmath.pas
@@ -31,17 +31,20 @@ interface
uses
Classes, SysUtils,MufasaTypes;
-function RotatePoints(P: TPointArray; A, cx, cy: Extended): TPointArray;
-function RotatePoint(p: TPoint; angle, mx, my: Extended): TPoint;
-
+function RotatePoints(const P: TPointArray;const A, cx, cy: Extended): TPointArray;
+function RotatePoint(const p: TPoint;const angle, mx, my: Extended): TPoint;
+function ChangeDistPT(const PT : TPoint; mx,my : integer; newdist : extended) : TPoint;
+function ChangeDistTPA(var TPA : TPointArray; mx,my : integer; newdist : extended) : boolean;
implementation
+uses
+ math;
{/\
Rotates the given points (P) by A (in radians) around the point defined by cx, cy.
/\}
-function RotatePoints(P: TPointArray; A, cx, cy: Extended): TPointArray;
+function RotatePoints(const P: TPointArray;const A, cx, cy: Extended): TPointArray;
var
I, L: Integer;
@@ -60,12 +63,43 @@ end;
Rotates the given point (p) by A (in radians) around the point defined by cx, cy.
/\}
-function RotatePoint(p: TPoint; angle, mx, my: Extended): TPoint;
+function RotatePoint(const p: TPoint;const angle, mx, my: Extended): TPoint;
begin
Result.X := Round(mx + cos(angle) * (p.x - mx) - sin(angle) * (p.y - my));
Result.Y := Round(my + sin(angle) * (p.x - mx) + cos(angle) * (p.y- my));
end;
+function ChangeDistPT(const PT : TPoint; mx,my : integer; newdist : extended) : TPoint;
+var
+ angle : extended;
+begin
+ angle := ArcTan2(pt.y-my,pt.x-mx);
+ result.y := round(sin(angle) * newdist) + mx;
+ result.x := round(cos(angle) * newdist) + my;
+end;
+
+function ChangeDistTPA(var TPA : TPointArray; mx,my : integer; newdist : extended) : boolean;
+var
+ angle : extended;
+ i : integer;
+begin
+ result := false;
+ if length(TPA) < 1 then
+ exit;
+ result := true;
+ try
+ for i := high(TPA) downto 0 do
+ begin
+ angle := ArcTan2(TPA[i].y-my,TPA[i].x-mx);
+ TPA[i].y := round(sin(angle) * newdist) + mx;
+ TPA[i].x := round(cos(angle) * newdist) + my;
+ end;
+ except
+ result := false;
+ end;
+
+end;
+
end.
diff --git a/Units/MMLCore/ocr.pas b/Units/MMLCore/ocr.pas
index a745a0a..5a4b8d1 100644
--- a/Units/MMLCore/ocr.pas
+++ b/Units/MMLCore/ocr.pas
@@ -41,9 +41,6 @@ type
private
Client: TObject;
FFonts: TMFonts;
- {$IFDEF OCRDEBUG}
- debugbmp: TMufasaBitmap;
- {$ENDIF}
function GetFonts:TMFonts;
procedure SetFonts(const NewFonts: TMFonts);
public
@@ -71,6 +68,8 @@ type
property Fonts : TMFonts read GetFonts write SetFonts;
{$IFDEF OCRDEBUG}
procedure DebugToBmp(bmp: TMufasaBitmap; hmod,h: integer);
+ public
+ debugbmp: TMufasaBitmap;
{$ENDIF}
end;
@@ -156,16 +155,20 @@ begin
{$ENDIF}
if FFonts.LoadFont(dirs[i], false) then
begin
+ {$IFDEF FONTDEBUG}
fonts_loaded := fonts_loaded + dirs[i] + ', ';
+ {$ENDIF}
result := true;
end;
end;
+ {$IFDEF FONTDEBUG}
if length(fonts_loaded) > 2 then
begin
writeln(fonts_loaded);
setlength(fonts_loaded,length(fonts_loaded)-2);
TClient(Self.Client).WriteLn('Loaded fonts: ' + fonts_loaded);
end;
+ {$ENDIF}
If DirectoryExists(path + 'UpChars') then
FFonts.LoadFont('UpChars', true); // shadow
end;
diff --git a/Units/MMLCore/tpa.pas b/Units/MMLCore/tpa.pas
index 2f9133f..0ba5876 100644
--- a/Units/MMLCore/tpa.pas
+++ b/Units/MMLCore/tpa.pas
@@ -29,7 +29,7 @@ interface
uses
Classes, SysUtils, mufasatypes;
-function FastTPASort(TPA: TPointArray; Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray;
+function FastTPASort(const TPA: TPointArray;const Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray;
procedure QuickSort(var A: TIntegerArray; iLo, iHi: Integer);
//Start Wizzyplugin
@@ -40,10 +40,10 @@ procedure RAaSTPAEx(var a: TPointArray; const w, h: Integer);
procedure RAaSTPA(var a: TPointArray; const Dist: Integer);
function NearbyPointInArrayEx(const P: TPoint; w, h:Integer; a: TPointArray): Boolean;
function NearbyPointInArray(const P: TPoint; Dist:Integer; a: TPointArray): Boolean;
-function ReArrangeandShortenArrayEx(a: TPointArray; w, h: Integer): TPointArray;
-function ReArrangeandShortenArray(a: TPointArray; Dist: Integer): TPointArray;
-function TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray;
-function TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray;
+function ReArrangeandShortenArrayEx(const a: TPointArray; w, h: Integer): TPointArray;
+function ReArrangeandShortenArray(const a: TPointArray; Dist: Integer): TPointArray;
+function TPAtoATPAEx(const TPA: TPointArray; w, h: Integer): T2DPointArray;
+function TPAtoATPA(const TPA: TPointArray; Dist: Integer): T2DPointArray;
procedure QuickTPASort(var A: TIntegerArray; var B: TPointArray; iLo, iHi: Integer; SortUp: Boolean);
procedure QuickATPASort(var A: TIntegerArray; var B: T2DPointArray; iLo, iHi: Integer; SortUp: Boolean);
procedure SortTPAFrom(var a: TPointArray; const From: TPoint);
@@ -51,51 +51,54 @@ procedure SortATPAFrom(var a: T2DPointArray; const From: TPoint);
procedure SortATPAFromFirstPoint(var a: T2DPointArray; const From: TPoint);
procedure InvertTPA(var a: TPointArray);
procedure InvertATPA(var a: T2DPointArray);
-function MiddleTPAEx(TPA: TPointArray; var x, y: Integer): Boolean;
-function MiddleTPA(tpa: TPointArray): TPoint;
+function MiddleTPAEx(const TPA: TPointArray; var x, y: Integer): Boolean;
+function MiddleTPA(const tpa: TPointArray): TPoint;
procedure SortATPASize(var a: T2DPointArray; const BigFirst: Boolean);
procedure SortATPAFromSize(var a: T2DPointArray; const Size: Integer; CloseFirst: Boolean);
-function CombineTPA(Ar1, Ar2: TPointArray): TPointArray;
-function CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray;
-function InIntArrayEx(a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;
-function InIntArray(a: TIntegerArray; Number: Integer): Boolean;
+function CombineTPA(const Ar1, Ar2: TPointArray): TPointArray;
+function CombineIntArray(const Ar1, Ar2: TIntegerArray): TIntegerArray;
+function InIntArrayEx(const a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;
+function InIntArray(const a: TIntegerArray; Number: Integer): Boolean;
procedure ClearSameIntegers(var a: TIntegerArray);
procedure ClearSameIntegersAndTPA(var a: TIntegerArray; var p: TPointArray);
-function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;
-function SplitTPA(arr: TPointArray; Dist: Integer): T2DPointArray;
+function SplitTPAEx(const arr: TPointArray; w, h: Integer): T2DPointArray;
+function SplitTPA(const arr: TPointArray; Dist: Integer): T2DPointArray;
+function FloodFillTPA(const TPA : TPointArray) : T2DPointArray;
procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);
+procedure FilterPointsDist(var Points: TPointArray; const MinDist,MaxDist: Extended; Mx, My: Integer);
procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);
-function RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;
-function GetATPABounds(ATPA: T2DPointArray): TBox;
-function GetTPABounds(TPA: TPointArray): TBox;
-function FindTPAinTPA(SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
-function FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
-function GetSamePointsATPA( ATPA : T2DPointArray; var Matches : TPointArray) : boolean;
-function FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray;
+function RemoveDistTPointArray(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;
+function GetATPABounds(const ATPA: T2DPointArray): TBox;
+function GetTPABounds(const TPA: TPointArray): TBox;
+function FindTPAinTPA(SearchTPA: TPointArray; const TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
+function FindTextTPAinTPA(Height : integer;const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
+function GetSamePointsATPA(const ATPA : T2DPointArray; var Matches : TPointArray) : boolean;
+function FindGapsTPA(const TPA: TPointArray; MinPixels: Integer): T2DPointArray;
procedure SortCircleWise(var tpa: TPointArray; const cx, cy, StartDegree: Integer; SortUp, ClockWise: Boolean);
procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean);
-Function MergeATPA(ATPA : T2DPointArray) : TPointArray;
+function MergeATPA(const ATPA : T2DPointArray) : TPointArray;
+procedure AppendTPA(var TPA : TPointArray; const ToAppend : TPointArray);
function TPAFromBox(const Box : TBox) : TPointArray;
-Function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ;
-Function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint; inline;
-function FindTPAEdges(p: TPointArray): TPointArray;
-function PointInTPA(p: TPoint; arP: TPointArray): Boolean;
-function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray;
+function FindTPAEdges(const p: TPointArray): TPointArray;
+function PointInTPA(const p: TPoint;const arP: TPointArray): Boolean;
+function ClearTPAFromTPA(const arP, ClearPoints: TPointArray): TPointArray;
procedure ClearDoubleTPA(var TPA: TPointArray);
Function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; const Box: TBox): TPointArray;
Procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean);
Procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean);
procedure InvertTIA(var tI: TIntegerArray);
-function SumIntegerArray(Ints : TIntegerArray): Integer;
-function AverageTIA(tI: TIntegerArray): Integer;
-function AverageExtended(tE: TExtendedArray): Extended;
-function SameTPA(aTPA, bTPA: TPointArray): Boolean;
-function TPAInATPA(TPA: TPointArray; InATPA: T2DPointArray; var Index: LongInt): Boolean;
+function SumIntegerArray(const Ints : TIntegerArray): Integer;
+function AverageTIA(const tI: TIntegerArray): Integer;
+function AverageExtended(const tE: TExtendedArray): Extended;
+function SameTPA(const aTPA, bTPA: TPointArray): Boolean;
+function TPAInATPA(const TPA: TPointArray;const InATPA: T2DPointArray; var Index: LongInt): Boolean;
+procedure OffsetTPA(var TPA : TPointArray; const Offset : TPoint);
+procedure OffsetATPA(var ATPA : T2DPointArray; const Offset : TPoint);
implementation
uses
- math;
+ math,mmath;
@@ -104,7 +107,7 @@ uses
Very Fast TPA Sort, uses an adepted CountSort algorithm.
/\}
-Function FastTPASort(TPA: TPointArray; Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray;
+Function FastTPASort(const TPA: TPointArray;const Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray;
{
If you want to understand this algorithm, it might be helpful to read about
@@ -353,7 +356,7 @@ end;
Results the TPointArray a with one point per box with side lengths W and H left.
/\}
-function ReArrangeandShortenArrayEx(a: TPointArray; w, h: Integer): TPointArray;
+function ReArrangeandShortenArrayEx(const a: TPointArray; w, h: Integer): TPointArray;
var
i, t, c, l: Integer;
Found: Boolean;
@@ -384,7 +387,7 @@ end;
Results the TPointArray a with one point per box with side length Dist left.
/\}
-function ReArrangeandShortenArray(a: TPointArray; Dist: Integer): TPointArray;
+function ReArrangeandShortenArray(const a: TPointArray; Dist: Integer): TPointArray;
var
i, t, c, l: Integer;
Found: Boolean;
@@ -415,7 +418,7 @@ end;
Splits the TPA to boxes with sidelengths W and H and results them as a T2DPointArray.
/\}
-function TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray;
+function TPAtoATPAEx(const TPA: TPointArray; w, h: Integer): T2DPointArray;
var
a, b, c, l: LongInt;
Found: Boolean;
@@ -451,7 +454,7 @@ end;
Splits the TPA to boxes with sidelength Dist and results them as a T2DPointArray.
/\}
-function TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray;
+function TPAtoATPA(const TPA: TPointArray; Dist: Integer): T2DPointArray;
var
a, b, c, l: LongInt;
Found: Boolean;
@@ -646,7 +649,7 @@ end;
Stores the coordinates of the middle of the TPointArray a to X and Y.
/\}
-function MiddleTPAEx(TPA: TPointArray; var x, y: Integer): Boolean;
+function MiddleTPAEx(const TPA: TPointArray; var x, y: Integer): Boolean;
var
i, l: Integer;
begin
@@ -669,7 +672,7 @@ end;
Returns the middle of the TPointArray tpa.
/\}
-function MiddleTPA(tpa: TPointArray): TPoint;
+function MiddleTPA(const tpa: TPointArray): TPoint;
var
i, l: Integer;
begin
@@ -725,7 +728,7 @@ end;
Combines the TPointArrays Ar1 and Ar2, and results the combination.
/\}
-function CombineTPA(Ar1, Ar2: TPointArray): TPointArray;
+function CombineTPA(const Ar1, Ar2: TPointArray): TPointArray;
var
i, l1, l2: Integer;
begin
@@ -741,7 +744,7 @@ end;
Combines the TIntegerArrays Ar1 and Ar2, and results the combination.
/\}
-function CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray;
+function CombineIntArray(const Ar1, Ar2: TIntegerArray): TIntegerArray;
var
i, l1, l2: Integer;
begin
@@ -757,7 +760,7 @@ end;
Returns true if the integer Number was found in the integer array a, and stores the index to Where.
/\}
-function InIntArrayEx(a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;
+function InIntArrayEx(const a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;
var
i, l: Integer;
begin
@@ -776,7 +779,7 @@ end;
Returns true if the integer Number was found in the integer array a.
/\}
-function InIntArray(a: TIntegerArray; Number: Integer): Boolean;
+function InIntArray(const a: TIntegerArray; Number: Integer): Boolean;
var
i, l: Integer;
begin
@@ -861,7 +864,7 @@ end;
Splits the points with max X and Y distances W and H to their own TPointArrays.
/\}
-function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;
+function SplitTPAEx(const arr: TPointArray; w, h: Integer): T2DPointArray;
var
t1, t2, c, ec, tc, l: Integer;
tpa: TPointArray;
@@ -908,7 +911,7 @@ end;
Dist 1 puts the points that are next to eachother to their own arrays.
/\}
-function SplitTPA(arr: TPointArray; Dist: Integer): T2DPointArray;
+function SplitTPA(const arr: TPointArray; Dist: Integer): T2DPointArray;
var
t1, t2, c, ec, tc, l: Integer;
tpa: TPointArray;
@@ -950,6 +953,105 @@ begin
SetLength(Result, c);
end;
+function FloodFillTPA(const TPA : TPointArray) : T2DPointArray;
+var
+ x,y,i,CurrentArray, LengthTPA,CurrentStack : integer;
+ TempBox : TBox;
+ PointsToFill : T2DBoolArray;
+ Lengths : TIntegerArray;
+ TempTPA : TPointArray;
+ Stack : TPointArray;
+ fx,fy : integer;
+begin;
+ LengthTPA := High(TPA);
+ if LengthTPA < 1 then
+ begin;
+ if LengthTPA = 0 then
+ begin;
+ SetLength(Result,1,1);
+ Result[0][0] := TPA[0];
+ end else
+ SetLength(Result,0);
+ exit;
+ end;
+ TempBox := GetTPABounds(TPA);
+ SetLength(PointsToFill,TempBox.x2 - TempBox.x1+3,TempBox.y2 - TempBox.y1+3); //W + 2, H + 2 so that we can check the borders
+ fy := TempBox.y2 - TempBox.y1+3;
+ fx := TempBox.x2 - TempBox.x1+2;
+ for i := 0 to fx do
+ FillChar(PointsToFill[i][0],fy,0);
+ x := TempBox.x1 - 1;
+ y := TempBox.y1 - 1;
+ CurrentArray := -1;
+ SetLength(Stack , LengthTPA + 1);
+ SetLength(Lengths , LengthTPA + 1);
+ SetLength(TempTPA , LengthTPA + 1);
+ for I := 0 to LengthTPA do
+ begin;
+ TempTPA[I].x := TPA[I].x - x;
+ TempTPA[I].y := TPA[I].y - y;
+ end;
+ for I := 0 to LengthTPA do
+ PointsToFill[TempTPA[I].x][TempTPA[I].y] := True;
+ for I := 0 to LengthTPA do
+ if PointsToFill[TempTPA[I].x][TempTPA[I].y] then
+ begin;
+ PointsToFill[TempTPA[i].x][TempTPA[i].y] := false;
+ inc(CurrentArray);
+ SetLength(Result,CurrentArray + 1);
+ SetLength(Result[CurrentArray],LengthTPA - I + 1);
+ Lengths[CurrentArray] := 0;
+ CurrentStack := 0;
+ Stack[0].x := TempTPA[I].x;
+ Stack[0].y := TempTPA[I].y;
+ While CurrentStack > -1 do
+ begin;
+ fx := stack[CurrentStack].x;
+ fy := stack[CurrentStack].y;
+ dec(CurrentStack);
+ Result[CurrentArray][Lengths[CurrentArray]].x := fx + x;
+ Result[CurrentArray][Lengths[CurrentArray]].y := fy + y;
+ inc(Lengths[CurrentArray]);
+ if PointsToFill[fx+1][fy] then
+ begin
+ inc(CurrentStack);Stack[CurrentStack].x := fx+1;Stack[Currentstack].y := fy;PointsToFill[fx+1][fy] := false;
+ end;
+ if PointsToFill[fx][fy+1] then
+ begin
+ inc(CurrentStack);Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy+1;PointsToFill[fx][fy+1] := false;
+ end;
+ if PointsToFill[fx-1][fy] then
+ begin
+ inc(CurrentStack);Stack[CurrentStack].x := fx-1;Stack[Currentstack].y := fy;PointsToFill[fx-1][fy] := false;
+ end;
+ if PointsToFill[fx][fy-1] then
+ begin
+ inc(CurrentStack);Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy-1;PointsToFill[fx][fy-1] := false;
+ end;
+ if PointsToFill[fx+1][fy+1] then
+ begin
+ inc(CurrentStack);Stack[CurrentStack].x := fx+1;Stack[Currentstack].y := fy+1;PointsToFill[fx+1][fy+1] := false;
+ end;
+ if PointsToFill[fx-1][fy-1] then
+ begin
+ inc(CurrentStack);Stack[CurrentStack].x := fx-1;Stack[Currentstack].y := fy-1;PointsToFill[fx-1][fy-1] := false;
+ end;
+ if PointsToFill[fx-1][fy+1] then
+ begin
+ inc(CurrentStack);Stack[CurrentStack].x := fx-1;Stack[Currentstack].y := fy+1;PointsToFill[fx-1][fy+1] := false;
+ end;
+ if PointsToFill[fx+1][fy-1] then
+ begin
+ inc(CurrentStack);Stack[CurrentStack].x := fx+1;Stack[Currentstack].y := fy-1;PointsToFill[fx+1][fy-1] := false;
+ end;
+ end;
+ SetLength(Result[CurrentArray],Lengths[CurrentArray]);
+ end;
+ SetLength(Stack,0);
+ SetLength(TempTPA,0);
+ SetLength(Lengths,0);
+end;
+
{/\
Removes the points in the TPointArray Points that are not within the degrees
\\ SD (StartDegree) and ED (EndDegree) and the distances MinR (MinRadius) and
@@ -999,15 +1101,43 @@ begin
Points := G;
end;
+{/\
+ Removes the points that don't have a dist between mindist/maxdist with (mx,my)
+/\}
+
+procedure FilterPointsDist(var Points: TPointArray; const MinDist,
+ MaxDist: Extended; Mx, My: Integer);
+var
+ c,i,l : integer;
+ d : extended;
+ mind,maxd : extended;
+begin
+ l := high(points);
+ c := 0;
+ mind := sqr(mindist);
+ maxd := sqr(maxdist);
+ for i := 0 to l do
+ begin
+ d := sqr(Points[i].x - mx) + sqr(points[i].y - my);
+ if (d >= mind) and (d <= maxd) then
+ begin
+ points[c] := points[i];
+ inc(c);
+ end;
+ end;
+ setlength(points,c);
+end;
+
{/\
Removes the points in the TPointArray Points that are not on the line defined by angle, radius and center.
/\}
+
procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);
var
I, Hi, Ind, y: Integer;
P: TPointArray;
Box: TBox;
- B: Array of Array of Boolean;
+ B: T2DBoolArray;
SinAngle,CosAngle : Extended;
begin
Ind := 0;
@@ -1017,7 +1147,10 @@ begin
SetLength(B, max(Box.x2, Round(SinAngle * Radius + MX)) + 1);
y:= max(Box.x2, -Round(CosAngle * Radius) + MY);
for I:= 0 to High(B) do
+ begin;
SetLength(B[I], y + 1);
+ FillChar(B[i][0],y+1,0);
+ end;
Hi:= High(Points);
for I:= 0 to Hi do
B[Points[I].x][Points[I].y]:= True;
@@ -1039,7 +1172,7 @@ end;
Removes the points that are inside or outside the distance Dist from the point (x, y) from the TPointArray ThePoints.
/\}
-function RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;
+function RemoveDistTPointArray(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;
var
I, L, LL: integer;
begin;
@@ -1070,7 +1203,7 @@ end;
Returns the boundaries of the ATPA as a TBox.
/\}
-function GetATPABounds(ATPA: T2DPointArray): TBox;
+function GetATPABounds(const ATPA: T2DPointArray): TBox;
var
I,II,L2,L : Integer;
begin;
@@ -1106,7 +1239,7 @@ end;
Returns the boundaries of the TPA as a TBox.
/\}
-function GetTPABounds(TPA: TPointArray): TBox;
+function GetTPABounds(const TPA: TPointArray): TBox;
var
I,L : Integer;
begin;
@@ -1135,11 +1268,11 @@ end;
\\ to the TPA Matches. Returns true if there were atleast one match(es).
/\}
-function FindTPAinTPA(SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
+function FindTPAinTPA(SearchTPA : TPointArray; const TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
var
Len, I,II,LenSearch,xOff,yOff : integer;
tx,ty,MatchCount : integer;
- Screen : Array of Array of Boolean;
+ Screen : T2DBoolArray;
ScreenBox,SearchBox : TBox;
Found: Boolean;
begin;
@@ -1153,6 +1286,8 @@ begin;
SearchBox := GetTPABounds(SearchTPA);
try
SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
+ for i := ScreenBox.x2 downto 0 do
+ FillChar(Screen[i][0],screenbox.y2+1,0);
except
Exit;
end;
@@ -1212,12 +1347,12 @@ end;
Read the description of FindTPAinTPA. Additional Height parameter.
/\}
-function FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
+function FindTextTPAinTPA(Height : integer;const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
var
Len, I,II,LenSearch,LenTPA,xOff,yOff,x,y: integer;
tx,ty,MatchCount : integer;
Found : boolean;
- Screen : Array of Array of Boolean;
+ Screen : T2DBoolArray;
ScreenBox,SearchBox : TBox;
InversedTPA : TPointArray;
begin;
@@ -1234,7 +1369,9 @@ begin;
if height > SearchBox.y2 then
Screenbox.y2 := Screenbox.y2 + (height - SearchBox.y2);
SearchBox.y2 := Height;
- SetLength(Screen, SearchBox.x2 + 1,Searchbox.y2 + 1);
+ SetLength(Screen, SearchBox.x2 + 1,SearchBox.y2 + 1);
+ for i := SearchBox.x2 downto 0 do
+ FillChar(screen[i][0],SearchBox.y2+1,0);
SetLength(InversedTPA,(SearchBox.x2 + 1) * (Searchbox.y2 + 1));
for I := 0 to LenSearch do
Screen[ SearchTPA[I].x,SearchTPA[I].y] := True;
@@ -1262,6 +1399,8 @@ begin;
try
SetLength(Screen,0);
SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
+ for i := ScreenBox.x2 downto 0 do
+ FillChar(screen[i][0],screenbox.y2+1,0);
except
Exit;
end;
@@ -1309,7 +1448,7 @@ end;
Finds the points that exist in all TPA's in the ATPA.
/\}
-function GetSamePointsATPA( ATPA : T2DPointArray; var Matches : TPointArray) : boolean;
+function GetSamePointsATPA(const ATPA : T2DPointArray; var Matches : TPointArray) : boolean;
var
I,ii,Len,MatchesC : integer;
MinBox,TempBox : TBox;
@@ -1381,10 +1520,10 @@ end;
\\ Only horizontal, sorry folks.
/\}
-function FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray;
+function FindGapsTPA(const TPA: TPointArray; MinPixels: Integer): T2DPointArray;
var
Len,TotalLen,LenRes,I,II,III : integer;
- Screen : Array of Array of Boolean;
+ Screen : T2DBoolArray;
Height,Width : Integer;
Box : TBox;
begin;
@@ -1397,6 +1536,8 @@ begin;
III := 0;
try
SetLength(Screen,Width + 1,Height + 1);
+ for i := 0 to Width do
+ FillChar(Screen[i][0],(Height+1),0);
except
Exit;
end;
@@ -1530,7 +1671,7 @@ end;
Merges the TPointArrays of the T2DPointArray ATPA in to one TPA.
/\}
-Function MergeATPA(ATPA: T2DPointArray): TPointArray;
+Function MergeATPA(const ATPA: T2DPointArray): TPointArray;
var
I, II, Len, TempL, CurrentL: integer;
begin;
@@ -1556,10 +1697,20 @@ begin;
end;
+procedure AppendTPA(var TPA: TPointArray; const ToAppend: TPointArray);
+var
+ l,lo,i : integer;
+begin
+ l := high(ToAppend);
+ lo := length(TPA);
+ setlength(TPA,lo + l + 1);
+ for i := 0 to l do
+ TPA[i + lo] := ToAppend[i];
+end;
+
{/\
Returns a TPointArray of a the full given Box.
/\}
-
function TPAFromBox(const Box : TBox) : TPointArray;
var
x, y: integer;
@@ -1614,9 +1765,9 @@ End;
Returns the edges of the given TPA.
/\}
-function FindTPAEdges(p: TPointArray): TPointArray;
+function FindTPAEdges(const p: TPointArray): TPointArray;
var
- b: array of array of Boolean;
+ b: T2DBoolArray;
i, x, y, l, c: Integer;
Box: TBox;
begin
@@ -1628,7 +1779,10 @@ begin
y := (Box.y2 - Box.y1) + 3;
SetLength(b, x);
for i := 0 to x -1 do
+ begin
SetLength(b[i], y);
+ FillChar(b[i][0],y,0);
+ end;
for i := 0 to l -1 do
b[p[i].x +1 - Box.x1][p[i].y +1 - Box.y1] := True;
SetLength(Result, l);
@@ -1659,7 +1813,7 @@ end;
Notes: In actuallys means IN the array, not in the box shaped by the array.
/\}
-function PointInTPA(p: TPoint; arP: TPointArray): Boolean;
+function PointInTPA(const p: TPoint;const arP: TPointArray): Boolean;
var
i, l: Integer;
begin
@@ -1677,11 +1831,12 @@ end;
Removes the given ClearPoints from arP.
/\}
-function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray;
+function ClearTPAFromTPA(const arP, ClearPoints: TPointArray): TPointArray;
var
i, j, l, l2: Integer;
Found: Boolean;
begin
+ Setlength(result,0);
l := High(arP);
l2 := High(ClearPoints);
for i := 0 to l do
@@ -1734,13 +1889,15 @@ end;
Function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; const Box: TBox): TPointArray;
var
x, y, w, h, i, l: integer;
- B: Array of Array of Boolean;
+ B: T2DBoolArray;
begin;
w := Box.x2 - Box.x1;
h := Box.y2 - Box.y1;
if (w = 0) and (h = 0) then
Exit;
SetLength(b, w + 1, h + 1);
+ for i := w downto 0 do
+ FillChar(b[i][0],h+1,0);
l := High(TotalTPA);
x := 0;
for i := 0 to l do
@@ -1772,13 +1929,15 @@ end;
Procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean);
Var
- c: Array Of Array Of Integer;
+ c: T2DIntegerArray;
I, II, III, hTPA, cc: Integer;
Begin
hTPA := High(TPA);
if hTPA < 1 then
Exit;
SetLength(c, max.X + 1,max.Y + 1);
+ for i := max.x downto 0 do
+ FillChar(c[i][0],(max.y+1)*sizeof(Integer),0);
For I := 0 To hTPA Do
c[TPA[I].x][TPA[I].y] := c[TPA[i].x][TPA[i].y] + 1;
@@ -1817,7 +1976,7 @@ End;
Procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean);
Var
- c: Array Of Array Of Integer;
+ c: T2DIntegerArray;
I, II, III, hTPA, cc: Integer;
Max : TPoint;
Begin
@@ -1827,6 +1986,8 @@ Begin
max.X := maxx.X - base.X;
max.Y := maxx.Y - base.Y;
SetLength(c, max.X + 1,max.Y + 1);
+ for i := max.x downto 0 do
+ FillChar(c[i][0],(max.y+1)*sizeof(integer),0);
hTPA := High(TPA);
For I := 0 To hTPA Do
c[TPA[I].x - base.X][TPA[I].y - base.Y] := c[TPA[i].x- base.X][TPA[i].y- base.Y] + 1;
@@ -1862,7 +2023,7 @@ End;
{/\
Returns the sum of all integers in the array
/\}
-function SumIntegerArray(Ints : TIntegerArray): Integer;
+function SumIntegerArray(const Ints : TIntegerArray): Integer;
var
I, H: Integer;
begin
@@ -1890,7 +2051,7 @@ end;
Results the Average of an IntegerArray
/\}
-function AverageTIA(tI: TIntegerArray): Integer;
+function AverageTIA(const tI: TIntegerArray): Integer;
begin
try Result := (SumIntegerArray(tI) div Length(tI)); except Result := 0; end;
end;
@@ -1898,7 +2059,7 @@ end;
{/\
Results the Average of an ExtendedArray
/\}
-function AverageExtended(tE: TExtendedArray): Extended;
+function AverageExtended(const tE: TExtendedArray): Extended;
var
i, h: Integer;
begin
@@ -1916,7 +2077,7 @@ end;
{/\
Returns true if the two inputed TPA's are exactly the same (so the order matters)
/\}
-function SameTPA(aTPA, bTPA: TPointArray): Boolean;
+function SameTPA(const aTPA, bTPA: TPointArray): Boolean;
var
I: LongInt;
h : integer;
@@ -1933,7 +2094,7 @@ end;
{/\
Returns true if the TPA is found as one of ATPA's sub-TPA's.. And again, order matters
/\}
-function TPAInATPA(TPA: TPointArray; InATPA: T2DPointArray; var Index: LongInt): Boolean;
+function TPAInATPA(const TPA: TPointArray;const InATPA: T2DPointArray; var Index: LongInt): Boolean;
var
I: LongInt;
h : integer;
@@ -1949,6 +2110,25 @@ begin
Result := False;
end;
+procedure OffsetTPA(var TPA: TPointArray; const Offset: TPoint);
+var
+ i : integer;
+begin
+ for i := high(TPA) downto 0 do
+ begin;
+ inc(TPA[i].x,offset.x);
+ inc(TPA[i].y,offset.y);
+ end;
+end;
+
+procedure OffsetATPA(var ATPA: T2DPointArray; const Offset: TPoint);
+var
+ i : integer;
+begin
+ for i := high(ATPA) downto 0 do
+ OffsetTPA(ATPA[i],Offset);
+end;
+
end.
diff --git a/Units/Misc/v_ideCodeInsight.pas b/Units/Misc/v_ideCodeInsight.pas
index d65a2b4..be5edb3 100644
--- a/Units/Misc/v_ideCodeInsight.pas
+++ b/Units/Misc/v_ideCodeInsight.pas
@@ -134,7 +134,7 @@ begin
for i := l - 1 downto 0 do
begin
- if (IncludeBuffer[i].CodeInsight.FileName = FileName) then
+ if (IncludeBuffer[i].CodeInsight <> nil) and (IncludeBuffer[i].CodeInsight.FileName = FileName) then
begin
DefineMatch := (IncludeBuffer[i].DefinesIn.Defines = Defines.Defines) and (IncludeBuffer[i].DefinesIn.Stack = Defines.Stack);
diff --git a/Units/PascalScript/uPSI_Dialogs.pas b/Units/PascalScript/uPSI_Dialogs.pas
index 893f93e..52721f6 100644
--- a/Units/PascalScript/uPSI_Dialogs.pas
+++ b/Units/PascalScript/uPSI_Dialogs.pas
@@ -27,7 +27,7 @@ type
implementation
uses
- Windows ,Messages ,CommDlg ,Graphics ,Controls ,Forms ,StdCtrls ,Dialogs;
+ { Windows ,}lcltype,Messages {,CommDlg },Graphics ,Controls ,Forms ,StdCtrls ,Dialogs;
(* === compile-time registration functions === *)
(*----------------------------------------------------------------------------*)
diff --git a/Units/PascalScript/uPSRuntime.pas b/Units/PascalScript/uPSRuntime.pas
index 49d96a6..0790bf6 100644
--- a/Units/PascalScript/uPSRuntime.pas
+++ b/Units/PascalScript/uPSRuntime.pas
@@ -10208,7 +10208,7 @@ begin
v := NewPPSVariantIFC(Stack[CurrStack + 1], True);
end else v := nil;
try
- Result := Caller.InnerfuseCall(FSelf, VirtualClassMethodPtrToPtr(p.Ext1, FSelf), cc, MyList, v);
+ Result := Caller.InnerfuseCall(FSelf, VirtualClassMethodPtrToPtr(p.Ext1, FSelf), TPSCallingConvention(Integer(cc) or 128), MyList, v);
finally
DisposePPSVariantIFC(v);
DisposePPSVariantIFCList(mylist);
diff --git a/Units/PascalScript/x86.inc b/Units/PascalScript/x86.inc
index df89435..e88053e 100644
--- a/Units/PascalScript/x86.inc
+++ b/Units/PascalScript/x86.inc
@@ -252,7 +252,7 @@ var
CallData: TPSList;
pp: ^Byte;
{$IFDEF FPC}
- IsConstructor: Boolean;
+ IsConstructor,IsVirtualCons: Boolean;
{$ENDIF}
EAX, EDX, ECX: Longint;
@@ -503,6 +503,18 @@ var
Result := True;
end;
begin
+ if (Integer(CallingConv) and 128) <> 0 then
+ begin
+ {$ifdef FPC}
+ IsVirtualCons := true;
+ {$endif}
+ CAllingConv := TPSCallingConvention(Integer(CallingConv) and not 128);
+ end else
+ begin
+ {$ifdef FPC}
+ IsVirtualCons:= false
+ {$endif}
+ end;
if (Integer(CallingConv) and 64) <> 0 then begin
{$IFDEF FPC}
IsConstructor := true;
@@ -573,13 +585,17 @@ 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 :
+ begin
{$IFDEF FPC}
- tbtu32(res.dta^) := RealCall_Register(Address, EDX, EAX, ECX,
- @Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil);
- {$ELSE}
- tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX,
- @Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil);
- {$ENDIF}
+ if IsConstructor or IsVirtualCons then
+ tbtu32(res.dta^) := RealCall_Register(Address, EDX, EAX, ECX,
+ @Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil)
+ else
+ {$ENDIF}
+// {$ELSE}
+ tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX,
+ @Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil);
+ end;
btu32,bts32{$IFDEF FPC},btArray{$ENDIF}: tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
btPChar: pansichar(res.dta^) := Pansichar(RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));