moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-23 07:48:50 -05:00
Code Issues Releases Wiki Activity

Merge ssh://villavu.com:54367/simba

Browse Source
This commit is contained in:
Niels 2010-05-13 11:42:10 +02:00
commit 10488dd0f8
54 changed files with 1168 additions and 545 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Plugins/libsmart.dll
View File

Binary file not shown.

3
Projects/OCRBench/unit1.pas
View File

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

4
Projects/SAMufasaGUI/Makefile → Projects/Simba/Makefile
View File

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

4
Projects/SAMufasaGUI/Makefile.win → Projects/Simba/Makefile.win
View File

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

0
Projects/SAMufasaGUI/project1.ico → Projects/Simba/Simba.ico
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 18 KiB

After

Width:  |  Height:  |  Size: 18 KiB

30
Projects/SAMufasaGUI/project1.lpi → Projects/Simba/Simba.lpi
View File

@ -40,19 +40,19 @@
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="46">
<Units Count="47">
<Unit0>
<Filename Value="project1.lpr"/>
<Filename Value="Simba.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="project1"/>
<UnitName Value="Simba"/>
</Unit0>
<Unit1>
<Filename Value="testunit.pas"/>
<Filename Value="simbaunit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ComponentName Value="SimbaForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="TestUnit"/>
<UnitName Value="SimbaUnit"/>
</Unit1>
<Unit2>
<Filename Value="../../Units/MMLCore/client.pas"/>
@ -205,7 +205,7 @@
<IsPartOfProject Value="True"/>
<ComponentName Value="SettingsForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="simbasettings"/>
<UnitName Value="SimbaSettings"/>
</Unit29>
<Unit30>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/tpa.inc"/>
@ -271,7 +271,7 @@
<Unit42>
<Filename Value="../../Units/Misc/dcpbase64.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="dcpbase64"/>
<UnitName Value="DCPbase64"/>
</Unit42>
<Unit43>
<Filename Value="../../Units/Misc/mPasLex.pas"/>
@ -288,6 +288,13 @@
<IsPartOfProject Value="True"/>
<UnitName Value="v_MiscFunctions"/>
</Unit45>
<Unit46>
<Filename Value="bitmapconv.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="BitmapConvForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="bitmapconv"/>
</Unit46>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -319,4 +326,11 @@
<CreateMakefileOnBuild Value="True"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="1">
<Item1>
<Name Value="ESyntaxError"/>
</Item1>
</Exceptions>
</Debugging>
</CONFIG>

15
Projects/SAMufasaGUI/project1.lpr → Projects/Simba/Simba.lpr
View File

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

0
Projects/SAMufasaGUI/project1.res → Projects/Simba/Simba.res
View File

0
Projects/SAMufasaGUI/about.lfm → Projects/Simba/about.lfm
View File

8
Projects/SAMufasaGUI/about.pas → Projects/Simba/about.pas
View File

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

68
Projects/Simba/bitmapconv.lfm Normal file
View File

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

91
Projects/Simba/bitmapconv.pas Normal file
View File

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

0
Projects/SAMufasaGUI/colourhistory.lfm → Projects/Simba/colourhistory.lfm
View File

8
Projects/SAMufasaGUI/colourhistory.pas → Projects/Simba/colourhistory.pas
View File

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

7
Projects/SAMufasaGUI/debugimage.lfm → Projects/Simba/debugimage.lfm
View File

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

4
Projects/SAMufasaGUI/debugimage.pas → Projects/Simba/debugimage.pas
View File

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

2
Projects/SAMufasaGUI/extensionmanager.pas → Projects/Simba/extensionmanager.pas
View File

@ -38,7 +38,7 @@ var
implementation
uses
TestUnit, settingssandbox,simbasettings;
SimbaUnit, settingssandbox,Simbasettings;
procedure TExtensionManager.SetOnchange(const AValue: TNotifyEvent);
var

0
Projects/SAMufasaGUI/extensionmanagergui.lfm → Projects/Simba/extensionmanagergui.lfm
View File

0
Projects/SAMufasaGUI/extensionmanagergui.pas → Projects/Simba/extensionmanagergui.pas
View File

12
Projects/SAMufasaGUI/framefunctionlist.lfm → Projects/Simba/framefunctionlist.lfm
View File

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

57
Projects/SAMufasaGUI/framefunctionlist.pas → Projects/Simba/framefunctionlist.pas
View File

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

2
Projects/SAMufasaGUI/framescript.lfm → Projects/Simba/framescript.lfm
View File

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

106
Projects/SAMufasaGUI/framescript.pas → Projects/Simba/framescript.pas
View File

@ -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('<no parameters expected>');
@ -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}

14
Projects/SAMufasaGUI/psextension.pas → Projects/Simba/psextension.pas
View File

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

0
Projects/SAMufasaGUI/simbasettings.lfm → Projects/Simba/simbasettings.lfm
View File

2
Projects/SAMufasaGUI/simbasettings.pas → Projects/Simba/simbasettings.pas
View File

@ -1,4 +1,4 @@
unit simbasettings;
unit Simbasettings;
{$mode objfpc}{$H+}

17
Projects/SAMufasaGUI/testunit.lfm → Projects/Simba/simbaunit.lfm
View File

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

412
Projects/SAMufasaGUI/testunit.pas → Projects/Simba/simbaunit.pas
View File

File diff suppressed because it is too large Load Diff

0
Projects/SAMufasaGUI/simpleanalyzer.pas → Projects/Simba/simpleanalyzer.pas
View File

0
Projects/SAMufasaGUI/updateform.lfm → Projects/Simba/updateform.lfm
View File

16
Projects/SAMufasaGUI/updateform.pas → Projects/Simba/updateform.pas
View File

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

0
Projects/SAMufasaGUI/virtualextension.pas → Projects/Simba/virtualextension.pas
View File

15
Units/MMLAddon/PSInc/Wrappers/file.inc
View File

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

22
Units/MMLAddon/PSInc/Wrappers/math.inc
View File

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

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

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

2
Units/MMLAddon/PSInc/Wrappers/strings.inc
View File

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

144
Units/MMLAddon/PSInc/Wrappers/tpa.inc
View File

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

2
Units/MMLAddon/PSInc/pscompile.inc
View File

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

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

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

20
Units/MMLAddon/mmisc.pas
View File

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

18
Units/MMLAddon/mmlpsthread.pas
View File

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

53
Units/MMLAddon/stringutil.pas
View File

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

12
Units/MMLCore/bitmaps.pas
View File

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

1
Units/MMLCore/colour_conv.pas
View File

@ -24,6 +24,7 @@
unit colour_conv;
{$mode objfpc}{$H+}
{$Inline on}
interface

4
Units/MMLCore/files.pas
View File

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

1
Units/MMLCore/finder.pas
View File

@ -104,6 +104,7 @@ uses
// colour_conv,// For RGBToColor, etc.
Client, // For the Client Casts.
math, //min/max
mmath,
tpa, //TPABounds
dtmutil
;

4
Units/MMLCore/libloader.pas
View File

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

44
Units/MMLCore/mmath.pas
View File

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

9
Units/MMLCore/ocr.pas
View File

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

322
Units/MMLCore/tpa.pas
View File

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

2
Units/Misc/v_ideCodeInsight.pas
View File

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

2
Units/PascalScript/uPSI_Dialogs.pas
View File

@ -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 === *)
(*----------------------------------------------------------------------------*)

2
Units/PascalScript/uPSRuntime.pas
View File

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

30
Units/PascalScript/x86.inc
View File

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