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

Cleaned up a bit, re-arranged some DTM stuff. Speeded FindDTMsRotated up a lil bit.. (Nanosec). Added some 'const' parameters. Fixed a small bug in File saving/opening.

Browse Source
This commit is contained in:
Raymond 2010-04-03 14:05:15 +02:00
parent b0a64c3331
commit 5ce90afbd6
9 changed files with 1244 additions and 1305 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
Projects/SAMufasaGUI/testunit.lfm
View File

@ -1,13 +1,13 @@
object Form1: TForm1 object Form1: TForm1
Left = 345 Left = 423
Height = 555 Height = 557
Top = 260 Top = 159
Width = 739 Width = 666
ActiveControl = ScriptPanel ActiveControl = ScriptPanel
AllowDropFiles = True AllowDropFiles = True
Caption = 'THA FUKING SIMBA' Caption = 'THA FUKING SIMBA'
ClientHeight = 535 ClientHeight = 537
ClientWidth = 739 ClientWidth = 666
KeyPreview = True KeyPreview = True
Menu = MainMenu Menu = MainMenu
OnClose = FormClose OnClose = FormClose
@ -21,7 +21,7 @@ object Form1: TForm1
Left = 0 Left = 0
Height = 24 Height = 24
Top = 0 Top = 0
Width = 739 Width = 666
Caption = 'ToolBar1' Caption = 'ToolBar1'
Images = Mufasa_Image_List Images = Mufasa_Image_List
ParentShowHint = False ParentShowHint = False
@ -207,9 +207,9 @@ object Form1: TForm1
end end
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Height = 22 Height = 23
Top = 513 Top = 514
Width = 739 Width = 666
Panels = < Panels = <
item item
Width = 60 Width = 60
@ -230,18 +230,21 @@ object Form1: TForm1
object PanelMemo: TPanel object PanelMemo: TPanel
Left = 0 Left = 0
Height = 154 Height = 154
Top = 359 Top = 360
Width = 739 Width = 666
Align = alBottom Align = alBottom
ClientHeight = 154 ClientHeight = 154
ClientWidth = 739 ClientWidth = 666
TabOrder = 2 TabOrder = 2
object Memo1: TMemo object Memo1: TMemo
Left = 1 Left = 1
Height = 152 Height = 152
Top = 1 Top = 1
Width = 737 Width = 664
Align = alClient Align = alClient
Font.Height = -13
Font.Name = 'Courier New'
ParentFont = False
ScrollBars = ssAutoBoth ScrollBars = ssAutoBoth
TabOrder = 0 TabOrder = 0
end end
@ -250,29 +253,29 @@ object Form1: TForm1
Cursor = crVSplit Cursor = crVSplit
Left = 0 Left = 0
Height = 5 Height = 5
Top = 354 Top = 355
Width = 739 Width = 666
Align = alBottom Align = alBottom
ResizeAnchor = akBottom ResizeAnchor = akBottom
end end
object ScriptPanel: TPanel object ScriptPanel: TPanel
Left = 0 Left = 0
Height = 330 Height = 331
Top = 24 Top = 24
Width = 739 Width = 666
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 330 ClientHeight = 331
ClientWidth = 739 ClientWidth = 666
DockSite = True DockSite = True
TabOrder = 4 TabOrder = 4
OnDockDrop = ScriptPanelDockDrop OnDockDrop = ScriptPanelDockDrop
OnDockOver = ScriptPanelDockOver OnDockOver = ScriptPanelDockOver
object PageControl1: TPageControl object PageControl1: TPageControl
Left = 155 Left = 155
Height = 295 Height = 296
Top = 0 Top = 0
Width = 584 Width = 511
Align = alClient Align = alClient
Images = Mufasa_Image_List Images = Mufasa_Image_List
PopupMenu = TabPopup PopupMenu = TabPopup
@ -289,12 +292,12 @@ object Form1: TForm1
object SearchPanel: TPanel object SearchPanel: TPanel
Left = 0 Left = 0
Height = 35 Height = 35
Top = 295 Top = 296
Width = 739 Width = 666
Align = alBottom Align = alBottom
BevelOuter = bvSpace BevelOuter = bvSpace
ClientHeight = 35 ClientHeight = 35
ClientWidth = 739 ClientWidth = 666
TabOrder = 1 TabOrder = 1
Visible = False Visible = False
object SpeedButtonSearch: TSpeedButton object SpeedButtonSearch: TSpeedButton
@ -385,7 +388,7 @@ object Form1: TForm1
end end
object LabeledEditSearch: TLabeledEdit object LabeledEditSearch: TLabeledEdit
Left = 104 Left = 104
Height = 23 Height = 21
Top = 6 Top = 6
Width = 174 Width = 174
EditLabel.AnchorSideLeft.Control = LabeledEditSearch EditLabel.AnchorSideLeft.Control = LabeledEditSearch
@ -395,7 +398,7 @@ object Form1: TForm1
EditLabel.AnchorSideBottom.Control = LabeledEditSearch EditLabel.AnchorSideBottom.Control = LabeledEditSearch
EditLabel.Left = 71 EditLabel.Left = 71
EditLabel.Height = 16 EditLabel.Height = 16
EditLabel.Top = 9 EditLabel.Top = 8
EditLabel.Width = 30 EditLabel.Width = 30
EditLabel.Caption = 'Find: ' EditLabel.Caption = 'Find: '
EditLabel.ParentColor = False EditLabel.ParentColor = False
@ -409,9 +412,9 @@ object Form1: TForm1
end end
object CheckBoxMatchCase: TCheckBox object CheckBoxMatchCase: TCheckBox
Left = 320 Left = 320
Height = 19 Height = 17
Top = 7 Top = 7
Width = 80 Width = 72
Caption = 'Match case' Caption = 'Match case'
OnClick = CheckBoxMatchCaseClick OnClick = CheckBoxMatchCaseClick
TabOrder = 1 TabOrder = 1
@ -419,28 +422,28 @@ object Form1: TForm1
end end
object SplitterFunctionList: TSplitter object SplitterFunctionList: TSplitter
Left = 150 Left = 150
Height = 295 Height = 296
Top = 0 Top = 0
Width = 5 Width = 5
OnCanResize = SplitterFunctionListCanResize OnCanResize = SplitterFunctionListCanResize
Visible = False Visible = False
end end
inline frmFunctionList: TFunctionListFrame inline frmFunctionList: TFunctionListFrame
Height = 295 Height = 296
Width = 150 Width = 150
ClientHeight = 295 ClientHeight = 296
ClientWidth = 150 ClientWidth = 150
OnEndDock = nil OnEndDock = nil
TabOrder = 3 TabOrder = 3
inherited FunctionList: TTreeView inherited FunctionList: TTreeView
Height = 252 Height = 257
Width = 150 Width = 150
OnChange = FunctionListChange OnChange = FunctionListChange
OnEnter = FunctionListEnter OnEnter = FunctionListEnter
OnExit = FunctionListExit OnExit = FunctionListExit
end end
inherited editSearchList: TEdit inherited editSearchList: TEdit
Top = 272 Top = 275
Width = 150 Width = 150
OnExit = editSearchListExit OnExit = editSearchListExit
OnKeyDown = editSearchListKeyDown OnKeyDown = editSearchListKeyDown

2083
Projects/SAMufasaGUI/testunit.lrs
View File

File diff suppressed because it is too large Load Diff

22
Projects/SAMufasaGUI/testunit.pas
View File

@ -335,10 +335,10 @@ type
procedure SetIncludePath(const AValue: String); procedure SetIncludePath(const AValue: String);
procedure SetShowHintAuto(const AValue: boolean); procedure SetShowHintAuto(const AValue: boolean);
procedure SetScriptState(const State: TScriptState); procedure SetScriptState(const State: TScriptState);
function LoadSettingDef(Key : string; Def : string) : string; function LoadSettingDef(const Key, Def : string) : string;
function CreateSetting(Key : string; Value : string) : string; function CreateSetting(const Key, Value : string) : string;
procedure SetSetting(key : string; Value : string; save : boolean = false); procedure SetSetting(const key,Value : string; save : boolean = false);
function SettingExtists(key : string) : boolean; function SettingExtists(const key : string) : boolean;
procedure FontUpdate; procedure FontUpdate;
public public
DebugStream: String; DebugStream: String;
@ -1289,15 +1289,15 @@ begin
with CurrScript do with CurrScript do
begin begin
ScriptFile:= SetDirSeparators(Filename); ScriptFile:= SetDirSeparators(Filename);
ScriptName:= ExtractFileNameOnly(Filename); ScriptName:= ExtractFileNameOnly(ScriptFile);
mDebugLn('Script name will be: ' + ScriptName); mDebugLn('Script name will be: ' + ScriptName);
FormWritelnEx('Succesfully saved: ' + Filename); FormWritelnEx('Succesfully saved: ' + ScriptFile);
StartText:= SynEdit.Lines.Text; StartText:= SynEdit.Lines.Text;
ScriptChanged := false; ScriptChanged := false;
SynEdit.MarkTextAsSaved; SynEdit.MarkTextAsSaved;
Self.Caption:= Format(WindowTitle,[ScriptName]); Self.Caption:= Format(WindowTitle,[ScriptName]);
CurrTab.TabSheet.Caption:= ScriptName; CurrTab.TabSheet.Caption:= ScriptName;
Self.AddRecentFile(FileName); Self.AddRecentFile(ScriptFile);
StatusBar.Panels[Panel_ScriptName].Text:= ScriptName; StatusBar.Panels[Panel_ScriptName].Text:= ScriptName;
StatusBar.Panels[Panel_ScriptPath].text:= ScriptFile; StatusBar.Panels[Panel_ScriptPath].text:= ScriptFile;
end; end;
@ -2381,17 +2381,17 @@ begin
end; end;
end; end;
function TForm1.LoadSettingDef(Key: string; Def: string): string; function TForm1.LoadSettingDef(const Key,Def: string): string;
begin begin
result := SettingsForm.Settings.GetKeyValueDefLoad(Key,def,SimbaSettingsFile); result := SettingsForm.Settings.GetKeyValueDefLoad(Key,def,SimbaSettingsFile);
end; end;
function TForm1.CreateSetting(Key: string; Value: string): string; function TForm1.CreateSetting(const Key,Value: string): string;
begin begin
result := SettingsForm.Settings.GetKeyValueDef(Key,value); result := SettingsForm.Settings.GetKeyValueDef(Key,value);
end; end;
procedure TForm1.SetSetting(key: string; Value: string; save : boolean); procedure TForm1.SetSetting(const key,Value: string; save : boolean);
begin begin
//Creates the setting if needed //Creates the setting if needed
SettingsForm.Settings.SetKeyValue(key,value); SettingsForm.Settings.SetKeyValue(key,value);
@ -2399,7 +2399,7 @@ begin
SettingsForm.Settings.SaveToXML(SimbaSettingsFile); SettingsForm.Settings.SaveToXML(SimbaSettingsFile);
end; end;
function TForm1.SettingExtists(key: string): boolean; function TForm1.SettingExtists(const key: string): boolean;
begin begin
result :=SettingsForm.Settings.KeyExists(key); result :=SettingsForm.Settings.KeyExists(key);
end; end;

122
Units/MMLAddon/PSInc/Wrappers/dtm.inc
View File

@ -21,110 +21,57 @@
DTM.inc for the Mufasa Macro Library DTM.inc for the Mufasa Macro Library
} }
function ps_FindDTM(DTM: Integer; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean; extdecl; function ps_FindDTM(DTM: Integer; out x, y: Integer; xs, ys, xe, ye: Integer): Boolean; extdecl;
var
temp: pDTM;
begin begin
if CurrThread.Client.MDTM.GetDTM(DTM, temp) then with CurrThread.Client do
Result := CurrThread.Client.MFinder.FindDTM(temp, x, y, x1, y1, x2, y2) result := MFinder.FindDTM(MDTM.GetDTM(DTM),x,y,xs,ys,xe,ye);
else
begin
x := 0;
y := 0;
Result := False;
end;
end; end;
function ps_FindDTMs(DTM: Integer; out p: TPointArray; x1, y1, x2, y2: Integer): Boolean; extdecl; function ps_FindDTMs(DTM: Integer; out p: TPointArray; xs, ys, xe, ye: Integer): Boolean; extdecl;
var
temp: pDTM;
begin begin
if CurrThread.Client.MDTM.GetDTM(DTM, temp) then with CurrThread.Client do
Result := CurrThread.Client.MFinder.FindDTMs(temp, p, x1, y1, x2, y2, 0) result := MFinder.FindDTMs(MDTM.GetDTM(DTM), p, xs, ys, xe, ye);
else
begin
setlength(p,0);
Result := False;
end;
end; end;
function ps_FindDTMRotatedAlternating(DTM: Integer; out x, y: Integer; x1, y1, x2, y2: function ps_FindDTMRotatedAlternating(DTM: Integer; out x, y: Integer; xs, ys, xe, ye:
Integer; sAngle, eAngle, aStep: Extended; Integer; sAngle, eAngle, aStep: Extended;
out aFound: Extended): Boolean; extdecl; out aFound: Extended): Boolean; extdecl;
var
temp: pDTM;
begin begin
if CurrThread.Client.MDTM.GetDTM(DTM, temp) then with CurrThread.Client do
Result := CurrThread.Client.MFinder.FindDTMRotated(temp, x, y, x1, y1, x2, y2, sAngle, eAngle, aStep, aFound,true) result := MFinder.FindDTMRotated(MDTM.GetDTM(DTM), x,y, xs, ys, xe, ye, sAngle, eAngle, aStep, aFound,true);
else
begin
x := 0;
y := 0;
Result := False;
end;
end; end;
function ps_FindDTMRotatedSE(DTM: Integer; out x, y: Integer; x1, y1, x2, y2: function ps_FindDTMRotatedSE(DTM: Integer; out x, y: Integer; xs, ys, xe, ye:
Integer; sAngle, eAngle, aStep: Extended; Integer; sAngle, eAngle, aStep: Extended;
out aFound: Extended): Boolean; extdecl; out aFound: Extended): Boolean; extdecl;
var
temp: pDTM;
begin begin
if CurrThread.Client.MDTM.GetDTM(DTM, temp) then with CurrThread.Client do
Result := CurrThread.Client.MFinder.FindDTMRotated(temp, x, y, x1, y1, x2, y2, sAngle, eAngle, aStep, aFound,false) result := MFinder.FindDTMRotated(MDTM.GetDTM(DTM), x, y, xs, ys, xe, ye, sAngle, eAngle, aStep, aFound,false);
else
begin
x := 0;
y := 0;
Result := False;
end;
end; end;
function ps_FindDTMsRotatedAlternating(DTM: Integer; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray): Boolean; extdecl; function ps_FindDTMsRotatedAlternating(DTM: Integer; out Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray): Boolean; extdecl;
var
temp: pDTM;
begin begin
if CurrThread.Client.MDTM.GetDTM(DTM, temp) then with CurrThread.Client do
Result := CurrThread.Client.MFinder.FindDTMsRotated(temp, Points, x1, y1, x2, y2, result := MFinder.FindDTMsRotated(MDTM.GetDTM(DTM), Points, xs, ys, xe, ye,
sAngle, eAngle, aStep, aFound, 0,true) sAngle, eAngle, aStep, aFound, true);
else
Result := False;
end; end;
function ps_FindDTMsRotatedSE(DTM: Integer; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray): Boolean; extdecl; function ps_FindDTMsRotatedSE(DTM: Integer; out Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray): Boolean; extdecl;
var
temp: pDTM;
begin begin
if CurrThread.Client.MDTM.GetDTM(DTM, temp) then with CurrThread.Client do
Result := CurrThread.Client.MFinder.FindDTMsRotated(temp, Points, x1, y1, x2, y2, result := MFinder.FindDTMsRotated(MDTM.GetDTM(DTM), Points, xs, ys, xe, ye,
sAngle, eAngle, aStep, aFound, 0,false) sAngle, eAngle, aStep, aFound, false);
else
Result := False;
end; end;
{function ps_FindDTMsRotated(DTM: Integer; out Points: TPointArray; x1, extdecl; procedure ps_SetDTMName(DTM : integer;const name : string);
y1, x2, y2: Integer; sAngle, eAngle,
aStep: Extended; out aFound: T2DExtendedArray)
: Boolean;
begin
Result := CurrThread.Client.MDTM.FindDTMsRotated(DTM, Points, x1, y1, x2, y2,
sAngle, eAngle, aStep, aFound);
end; }
procedure ps_SetDTMName(DTM : integer; name : string);
begin begin
CurrThread.Client.MDTM.SetDTMName(DTM,name); CurrThread.Client.MDTM.SetDTMName(DTM,name);
end; end;
function ps_DTMFromString(DTMString: String): Integer; extdecl; function ps_DTMFromString(const DTMString: String): Integer; extdecl;
var
dtm: pDTM;
begin begin
With CurrThread.Client.MDTM do With CurrThread.Client.MDTM do
begin Result := AddpDTM(StringToDTM(DTMString));
dtm := StringToDTM(DTMString);
Result := AddpDTM(dtm);
end;
end; end;
procedure ps_FreeDTM(DTM: Integer); extdecl; procedure ps_FreeDTM(DTM: Integer); extdecl;
@ -132,23 +79,32 @@ begin
CurrThread.Client.MDTM.FreeDTM(DTM); CurrThread.Client.MDTM.FreeDTM(DTM);
end; end;
function ps_GetDTM(index: Integer; out dtm: pDTM): Boolean; extdecl; function ps_GetDTM(index: Integer) : pDTM; extdecl;
begin begin
Result := CurrThread.Client.MDTM.GetDTM(index, dtm); CurrThread.Client.MDTM.GetDTM(index);
end; end;
function ps_AddDTM(d: TDTM): Integer; extdecl; function ps_AddDTM(const d: TDTM): Integer; extdecl;
begin begin
Result := CurrThread.Client.MDTM.AddDTM(d); Result := CurrThread.Client.MDTM.AddDTM(d);
end; end;
function ps_AddpDTM(d: pDTM): Integer; extdecl; function ps_AddpDTM(const d: pDTM): Integer; extdecl;
begin begin
Result := CurrThread.Client.MDTM.AddpDTM(d); Result := CurrThread.Client.MDTM.AddpDTM(d);
end; end;
Procedure ps_PrintpDTM(aDTM : pDTM);extdecl; procedure ps_PrintpDTM(const aDTM : pDTM);extdecl;
begin begin
PrintpDTM(aDTM); PrintpDTM(aDTM);
end; end;
function ps_pDTMToTDTM(Const DTM: pDTM): TDTM;extdecl;
begin
result := pDTMToTDTM(DTM);
end;
function ps_tDTMTopDTM(Const DTM: TDTM): pDTM;extdecl;
begin
result := tDTMTopDTM(DTM);
end;

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

@ -26,22 +26,21 @@ AddFunction(@pswriteln,'procedure Writeln(x: string);'); //PS defines a special,
{ DTM } { DTM }
SetCurrSection('DTM'); SetCurrSection('DTM');
AddFunction(@ps_PrintpDTM, 'Procedure PrintpDTM(tDTM : pDTM);'); AddFunction(@ps_SetDTMName, 'procedure SetDTMName(DTM : integer;const name : string);');
AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer; out dtm: pDTM): Boolean;'); AddFunction(@ps_DTMFromString, 'function DTMFromString(const DTMString: String): Integer;');
AddFunction(@pDTMToTDTM, 'Function pDTMToTDTM(DTM: pDTM): TDTM;');
AddFunction(@tDTMTopDTM, 'Function tDTMTopDTM(DTM: TDTM): pDTM;');
AddFunction(@ps_SetDTMName, 'procedure SetDTMName(DTM : integer; name : string);');
AddFunction(@ps_DTMFromString, 'function DTMFromString(DTMString: String): Integer;');
AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: Integer);'); AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: Integer);');
AddFunction(@ps_FindDTM, 'function FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;'); AddFunction(@ps_FindDTM, 'function FindDTM(DTM: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;');
AddFunction(@ps_FindDTMs, 'function FindDTMs(DTM: Integer; var p: TPointArray; x1, y1, x2, y2: Integer): Boolean;'); AddFunction(@ps_FindDTMs, 'function FindDTMs(DTM: Integer; var p: TPointArray; xs, ys, xe, ye: Integer): Boolean;');
AddFunction(@ps_FindDTMRotatedSE, 'function FindDTMRotatedSE(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;'); AddFunction(@ps_FindDTMRotatedSE, 'function FindDTMRotatedSE(DTM: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;');
AddFunction(@ps_FindDTMRotatedAlternating, 'function FindDTMRotatedAlternating(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;'); AddFunction(@ps_FindDTMRotatedAlternating, 'function FindDTMRotatedAlternating(DTM: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;');
AddFunction(@ps_FindDTMsRotatedSE, 'function FindDTMsRotatedSE(DTM: Integer; var Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;'); AddFunction(@ps_FindDTMsRotatedSE, 'function FindDTMsRotatedSE(DTM: Integer; var Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;');
AddFunction(@ps_FindDTMsRotatedAlternating, 'function FindDTMsRotatedAlternating(DTM: Integer; var Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;'); AddFunction(@ps_FindDTMsRotatedAlternating, 'function FindDTMsRotatedAlternating(DTM: Integer; var Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;');
AddFunction(@ps_addDTM, 'function AddDTM(d: TDTM): Integer;'); AddFunction(@ps_addDTM, 'function AddDTM(const d: TDTM): Integer;');
AddFunction(@ps_addpDTM, 'function AddpDTM(d: pDTM): Integer;'); AddFunction(@ps_addpDTM, 'function AddpDTM(const d: pDTM): Integer;');
AddFunction(@ps_PrintpDTM, 'procedure PrintpDTM(const tDTM : pDTM);');
AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer) : pDTM');
AddFunction(@ps_pDTMToTDTM, 'function pDTMToTDTM(const DTM: pDTM): TDTM;');
AddFunction(@ps_tDTMTopDTM, 'function tDTMTopDTM(const DTM: TDTM): pDTM;');
{maths} {maths}
SetCurrSection('Math'); SetCurrSection('Math');
@ -55,13 +54,13 @@ AddFunction(@ps_minE,'function MinE(a, b: extended): Extended;');
AddFunction(@ps_maxE,'function MaxE(a, b: extended): Extended;'); AddFunction(@ps_maxE,'function MaxE(a, b: extended): Extended;');
AddFunction(@ps_iAbs,'function iAbs(a : integer) : integer;'); AddFunction(@ps_iAbs,'function iAbs(a : integer) : integer;');
AddFunction(@ps_ArcTan2,'function ArcTan2(x,y : extended) : extended;'); AddFunction(@ps_ArcTan2,'function ArcTan2(x,y : extended) : extended;');
AddFunction(@IntToBox,'function IntToBox(x1,y1,x2,y2 : integer) : TBox;'); AddFunction(@IntToBox,'function IntToBox(xs,ys,xe,ye : integer) : TBox;');
AddFunction(@IntInBox,'function IntInBox(x, y: Integer; Box: TBox): Boolean;'); AddFunction(@IntInBox,'function IntInBox(x, y: Integer; Box: TBox): Boolean;');
AddFunction(@PointToBox,'function PointToBox(PT1,PT2 : TPoint): TBox;'); AddFunction(@PointToBox,'function PointToBox(PT1,PT2 : TPoint): TBox;');
AddFunction(@PointInBox,'function PointInBox(PT : TPoint; Box: TBox): Boolean;'); AddFunction(@PointInBox,'function PointInBox(PT : TPoint; Box: TBox): Boolean;');
AddFunction(@ps_sqr,'function Sqr(e : extended) : extended;'); AddFunction(@ps_sqr,'function Sqr(e : extended) : extended;');
AddFunction(@ps_point,'function Point(x,y:integer) : TPoint;'); AddFunction(@ps_point,'function Point(x,y:integer) : TPoint;');
AddFunction(@ps_Distance,'function Distance(x1,y1,x2,y2 : integer) : integer;'); AddFunction(@ps_Distance,'function Distance(xs,ys,xe,ye : integer) : integer;');
AddFunction(@ps_hypot,'function Hypot(X, Y: Extended): Extended;'); AddFunction(@ps_hypot,'function Hypot(X, Y: Extended): Extended;');
AddFunction(@ps_RandomRange,'function RandomRange(aFrom,aTo: Integer): Integer;'); AddFunction(@ps_RandomRange,'function RandomRange(aFrom,aTo: Integer): Integer;');
AddFunction(@ps_incex,'procedure IncEx(var x : integer; increase : integer);'); AddFunction(@ps_incex,'procedure IncEx(var x : integer; increase : integer);');
@ -99,7 +98,7 @@ AddFunction(@ps_EndOfFile, 'function EndOfFile(FileNum: Integer): Boolean;');
AddFunction(@ps_FileSize, 'function FileSize(FileNum: Integer): LongInt;'); AddFunction(@ps_FileSize, 'function FileSize(FileNum: Integer): LongInt;');
AddFunction(@ps_ReadFileString, 'function ReadFileString(FileNum: Integer; var s: string; x: Integer): Boolean;'); AddFunction(@ps_ReadFileString, 'function ReadFileString(FileNum: Integer; var s: string; x: Integer): Boolean;');
AddFunction(@ps_WriteFileString, 'function WriteFileString(FileNum: Integer; s: string): Boolean;'); AddFunction(@ps_WriteFileString, 'function WriteFileString(FileNum: Integer; s: string): Boolean;');
AddFunction(@ps_SetFileCharPointer, 'Function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;'); AddFunction(@ps_SetFileCharPointer, 'function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;');
AddFunction(@ps_FilePointerPos, 'function FilePointerPos(FileNum: Integer): Integer;'); AddFunction(@ps_FilePointerPos, 'function FilePointerPos(FileNum: Integer): Integer;');
AddFunction(@ps_DirectoryExists,'function DirectoryExists( const DirectoryName : string ) : Boolean;'); AddFunction(@ps_DirectoryExists,'function DirectoryExists( const DirectoryName : string ) : Boolean;');
AddFunction(@ps_CreateDirectory,'function CreateDirectory( const DirectoryName : string) : boolean;'); AddFunction(@ps_CreateDirectory,'function CreateDirectory( const DirectoryName : string) : boolean;');
@ -129,7 +128,7 @@ AddFunction(@GetDebugBitmap,'function GetDebugBitmap: integer;');
AddFunction(@ps_Random,'function Random(Int: integer): integer;'); AddFunction(@ps_Random,'function Random(Int: integer): integer;');
AddFunction(@ClearDebug,'procedure ClearDebug;'); AddFunction(@ClearDebug,'procedure ClearDebug;');
AddFunction(@PlaySound,'procedure PlaySound( Sound : string);'); AddFunction(@PlaySound,'procedure PlaySound( Sound : string);');
AddFunction(@StopSound,'Procedure StopSound;'); AddFunction(@StopSound,'procedure StopSound;');
AddFunction(@psSetScriptProp, 'function SetScriptProp(Prop : TSP_Property; Value: String): boolean;'); AddFunction(@psSetScriptProp, 'function SetScriptProp(Prop : TSP_Property; Value: String): boolean;');
AddFunction(@psGetScriptProp, 'function GetScriptProp(Prop : TSP_Property;var Value: String): boolean;'); AddFunction(@psGetScriptProp, 'function GetScriptProp(Prop : TSP_Property;var Value: String): boolean;');
@ -196,10 +195,10 @@ AddFunction(@GetToleranceSpeed2Modifiers, 'procedure GetToleranceSpeed2Modifiers
AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;'); AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
AddFunction(@GetColors,'function GetColors(Coords : TPointArray) : TIntegerArray;'); AddFunction(@GetColors,'function GetColors(Coords : TPointArray) : TIntegerArray;');
AddFunction(@GetColorsWrap,'procedure GetColorsWrap(Coords : TPointArray; var Colors :TIntegerArray);'); AddFunction(@GetColorsWrap,'procedure GetColorsWrap(Coords : TPointArray; var Colors :TIntegerArray);');
AddFunction(@FindColor, 'function FindColor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;'); AddFunction(@FindColor, 'function FindColor(var x, y: integer; color, xs, ys, xe, ye: integer): boolean;');
AddFunction(@findcolortoleranceOptimised, 'function FindColorToleranceOptimised(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;'); AddFunction(@findcolortoleranceOptimised, 'function FindColorToleranceOptimised(var x, y: integer; color, xs, ys, xe, ye, tol: integer): boolean;');
AddFunction(@FindColorTolerance, 'function FindColorTolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;'); AddFunction(@FindColorTolerance, 'function FindColorTolerance(var x, y: integer; color, xs, ys, xe, ye, tol: integer): boolean;');
AddFunction(@FindColors, 'function FindColors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;'); AddFunction(@FindColors, 'function FindColors(var TPA: TPointArray; color, xs, ys, xe, ye: integer): boolean;');
AddFunction(@SimilarColors,'function SimilarColors(Col1, Col2, Tolerance: integer): boolean'); AddFunction(@SimilarColors,'function SimilarColors(Col1, Col2, Tolerance: integer): boolean');
AddFunction(@CountColor,'function CountColor(Color, xs, ys, xe, ye: Integer): Integer;'); AddFunction(@CountColor,'function CountColor(Color, xs, ys, xe, ye: Integer): Integer;');
AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;'); AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;');
@ -323,7 +322,7 @@ AddFunction(@GetSamePointsATPA,'function GetSamePointsATPA( ATPA : T2DPointArray
AddFunction(@FindTextTPAinTPA,'function FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;'); AddFunction(@FindTextTPAinTPA,'function FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;');
AddFunction(@SortCircleWise,'procedure SortCircleWise(var tpa: TPointArray; const cx, cy, StartDegree: Integer; SortUp, ClockWise: Boolean);'); AddFunction(@SortCircleWise,'procedure SortCircleWise(var tpa: TPointArray; const cx, cy, StartDegree: Integer; SortUp, ClockWise: Boolean);');
AddFunction(@LinearSort,'procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean);'); AddFunction(@LinearSort,'procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean);');
AddFunction(@RotatePoint,'Function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint;'); AddFunction(@RotatePoint,'function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint;');
AddFunction(@FindGapsTPA,'function FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray;'); AddFunction(@FindGapsTPA,'function FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray;');
AddFunction(@RemoveDistTPointArray,'function RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;'); AddFunction(@RemoveDistTPointArray,'function RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;');
AddFunction(@CombineTPA,'function CombineTPA(Ar1, Ar2: TPointArray): TPointArray;'); AddFunction(@CombineTPA,'function CombineTPA(Ar1, Ar2: TPointArray): TPointArray;');
@ -332,16 +331,16 @@ AddFunction(@ReArrangeandShortenArray,'function ReArrangeandShortenArray(a: TPoi
AddFunction(@TPAtoATPAEx,'function TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray;'); AddFunction(@TPAtoATPAEx,'function TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray;');
AddFunction(@TPAtoATPA,'function TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray;'); AddFunction(@TPAtoATPA,'function TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray;');
AddFunction(@CombineIntArray,'function CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray;'); AddFunction(@CombineIntArray,'function CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray;');
AddFunction(@MergeATPA,'Function MergeATPA(ATPA : T2DPointArray) : TPointArray;'); AddFunction(@MergeATPA,'function MergeATPA(ATPA : T2DPointArray) : TPointArray;');
AddFunction(@TPAFromBox,'function TPAFromBox(const Box : TBox) : TPointArray;'); AddFunction(@TPAFromBox,'function TPAFromBox(const Box : TBox) : TPointArray;');
AddFunction(@RotatePoints,'Function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ;'); AddFunction(@RotatePoints,'function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ;');
AddFunction(@FindTPAEdges,'function FindTPAEdges(p: TPointArray): TPointArray;'); AddFunction(@FindTPAEdges,'function FindTPAEdges(p: TPointArray): TPointArray;');
AddFunction(@ClearTPAFromTPA,'function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray;'); AddFunction(@ClearTPAFromTPA,'function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray;');
AddFunction(@ReturnPointsNotInTPA,'Function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; const Box: TBox): TPointArray;'); AddFunction(@ReturnPointsNotInTPA,'function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; const Box: TBox): TPointArray;');
AddFunction(@PointInTPA,'function PointInTPA(p: TPoint; arP: TPointArray): Boolean;'); AddFunction(@PointInTPA,'function PointInTPA(p: TPoint; arP: TPointArray): Boolean;');
AddFunction(@ClearDoubleTPA,'procedure ClearDoubleTPA(var TPA: TPointArray);'); AddFunction(@ClearDoubleTPA,'procedure ClearDoubleTPA(var TPA: TPointArray);');
AddFunction(@TPACountSort,'Procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean);'); AddFunction(@TPACountSort,'procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean);');
AddFunction(@TPACountSortBase,'Procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean);'); AddFunction(@TPACountSortBase,'procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean);');
AddFunction(@InvertTIA,'procedure InvertTIA(var tI: TIntegerArray);'); AddFunction(@InvertTIA,'procedure InvertTIA(var tI: TIntegerArray);');
AddFunction(@SumIntegerArray,'function SumIntegerArray(Ints : TIntegerArray): Integer;'); AddFunction(@SumIntegerArray,'function SumIntegerArray(Ints : TIntegerArray): Integer;');
AddFunction(@AverageTIA,'function AverageTIA(tI: TIntegerArray): Integer;'); AddFunction(@AverageTIA,'function AverageTIA(tI: TIntegerArray): Integer;');

102
Units/MMLCore/dtm.pas
View File

@ -31,18 +31,22 @@ uses
Classes, SysUtils, MufasaTypes; Classes, SysUtils, MufasaTypes;
type type
{ TMDTM }
TMDTM = class(TObject) TMDTM = class(TObject)
private private
Client: TObject; Client: TObject;
DTMList: Array Of pDTM; DTMList: Array Of pDTM;
FreeSpots: Array Of Integer; FreeSpots: Array Of Integer;
procedure CheckIndex(index : integer);
public public
function AddDTM(const d: TDTM): Integer; function AddDTM(const d: TDTM): Integer;
function AddpDTM(const d: pDTM): Integer; function AddpDTM(const d: pDTM): Integer;
function GetDTM(index: Integer; out dtm: pDTM): Boolean; function GetDTM(index: Integer) :pDTM;
procedure FreeDTM(DTM: Integer); procedure FreeDTM(DTM: Integer);
function StringToDTM(const S: String): pDTM; function StringToDTM(const S: String): pDTM;
function SetDTMName(DTM: Integer;const S: String): boolean; procedure SetDTMName(DTM: Integer;const S: String);
constructor Create(Owner: TObject); constructor Create(Owner: TObject);
destructor Destroy; override; destructor Destroy; override;
end; end;
@ -158,21 +162,15 @@ begin
result.l := length(result.p); result.l := length(result.p);
end; end;
function TMDTM.AddDTM(const d: TDTM): Integer; procedure TMDTM.CheckIndex(index: integer);
begin begin
if Length(FreeSpots) > 0 then if (index < 0) or (index >= Length(DTMList)) then
begin raise Exception.CreateFmt('The given DTM Index[%d] doesn''t exist',[index]);
DTMList[FreeSpots[High(FreeSpots)]] := TDTMTopDTM(d); end;
Result := FreeSpots[High(FreeSpots)];
SetLength(FreeSpots, High(FreeSpots)); function TMDTM.AddDTM(const d: TDTM): Integer;
end begin
else Result := AddpDTM(tDTMTopDTM(d));
begin
SetLength(DTMList, Length(DTMList) + 1);
DTMList[High(DTMList)] := TDTMTopDTM(d);
Result := High(DTMList);
end;
end; end;
{/\ {/\
@ -180,7 +178,6 @@ end;
/\} /\}
function TMDTM.AddpDTM(const d: pDTM): Integer; function TMDTM.AddpDTM(const d: pDTM): Integer;
begin begin
if Length(FreeSpots) > 0 then if Length(FreeSpots) > 0 then
begin begin
@ -188,12 +185,13 @@ begin
Result := FreeSpots[High(FreeSpots)]; Result := FreeSpots[High(FreeSpots)];
SetLength(FreeSpots, High(FreeSpots)); SetLength(FreeSpots, High(FreeSpots));
end end
Else else
begin begin
SetLength(DTMList, Length(DTMList) + 1); SetLength(DTMList, Length(DTMList) + 1);
DTMList[High(DTMList)] := d; DTMList[High(DTMList)] := d;
Result := High(DTMList); Result := High(DTMList);
end; end;
NormalizeDTM(DTMList[result]);
end; end;
{/\ {/\
@ -201,30 +199,16 @@ end;
Returns true is succesfull, false if the dtm does not exist. Returns true is succesfull, false if the dtm does not exist.
/\} /\}
function TMDTM.GetDTM(index: Integer; out dtm: pDTM): Boolean; function TMDTM.GetDTM(index: Integer) :pDTM;
begin begin
Result := True; CheckIndex(index);
try result := DTMList[index];
dtm := DTMList[index];
except
begin
raise Exception.CreateFmt('The given DTM Index ([%d]) is invalid.',
[index]);
//WriteLn('DTM Index ' + IntToStr(index) + ' does not exist');
Result := False;
end;
end
end; end;
function TMDTM.SetDTMName(DTM: Integer;const s: string): boolean; procedure TMDTM.SetDTMName(DTM: Integer;const s: string);
begin begin
try CheckIndex(DTM);
DTMList[DTM].n:= s; DTMList[DTM].n := s;
Exit(true);
except
raise Exception.CreateFMT('SetDTMName: The given DTM %d does not exist.', [DTM]);
end;
Exit(False);
end; end;
{/\ {/\
@ -233,19 +217,17 @@ end;
Will keep track of not used index, so it is very memory efficient. Will keep track of not used index, so it is very memory efficient.
/\} /\}
Procedure TMDTM.FreeDTM(DTM: Integer); procedure TMDTM.FreeDTM(DTM: Integer);
begin begin
try CheckIndex(DTM);
SetLength(DTMList[DTM].p, 0); SetLength(DTMList[DTM].p, 0);
SetLength(DTMList[DTM].c, 0); SetLength(DTMList[DTM].c, 0);
SetLength(DTMList[DTM].t, 0); SetLength(DTMList[DTM].t, 0);
SetLength(DTMList[DTM].asz, 0); SetLength(DTMList[DTM].asz, 0);
SetLength(DTMList[DTM].ash, 0); SetLength(DTMList[DTM].ash, 0);
DTMList[DTM].l := 0; SetLength(DTMList[DTM].bp,0);
except DTMList[DTM].l := 0;
raise Exception.CreateFmt('Invalid DTM passed to FreeDTM', []); DTMList[DTM].n := '';
//WriteLn('Invalid DTM');
end;
SetLength(FreeSpots, Length(FreeSpots) + 1); SetLength(FreeSpots, Length(FreeSpots) + 1);
FreeSpots[High(FreeSpots)] := DTM; FreeSpots[High(FreeSpots)] := DTM;
end; end;
@ -279,20 +261,20 @@ end;
Returns all Angles in an Extended array. Returns all Angles in an Extended array.
/\} /\}
{Function TMDTM.FindDTMRotated(DTM: Integer; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean; {function TMDTM.FindDTMRotated(DTM: Integer; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;
Var Var
temp: pDTM; temp: pDTM;
Begin Begin
If GetDTM(DTM, temp) Then If GetDTM(DTM, temp) Then
Result := pFindDTMRotated(temp, x, y, x1, y1, x2, y2, sAngle, eAngle, aStep, aFound) Result := pFindDTMRotated(temp, x, y, x1, y1, x2, y2, sAngle, eAngle, aStep, aFound)
Else else
Begin Begin
x := 0; x := 0;
y := 0; y := 0;
aFound := 0.0; aFound := 0.0;
Result := False; Result := False;
End; end;
End; } end; }
{/\ {/\
Tries to find the given pDTM. If found will put the point the dtm has Tries to find the given pDTM. If found will put the point the dtm has
@ -301,11 +283,11 @@ End; }
Returns all Angles in an Extended array. Returns all Angles in an Extended array.
/\} /\}
{Function TMDTM.pFindDTMRotated(DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean; {function TMDTM.pFindDTMRotated(DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;
Begin Begin
End; } end; }
{/\ {/\
Tries to find the given DTM (index). Will return true if it has found one or more Tries to find the given DTM (index). Will return true if it has found one or more
@ -315,19 +297,19 @@ End; }
Returns all Angles in a Two Dimensional Extended array. Returns all Angles in a Two Dimensional Extended array.
/\} /\}
{Function TMDTM.FindDTMsRotated(DTM: Integer; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray): Boolean; {function TMDTM.FindDTMsRotated(DTM: Integer; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray): Boolean;
Var Var
temp: pDTM; temp: pDTM;
Begin Begin
If GetDTM(DTM, temp) Then If GetDTM(DTM, temp) Then
Result := pFindDTMsRotated(temp, Points, x1, y1, x2, y2, sAngle, eAngle, aStep, aFound) Result := pFindDTMsRotated(temp, Points, x1, y1, x2, y2, sAngle, eAngle, aStep, aFound)
Else else
Begin Begin
SetLength(Points, 0); SetLength(Points, 0);
SetLength(aFound, 0); SetLength(aFound, 0);
Result := False; Result := False;
End; end;
End; } end; }
{/\ {/\
Tries to find the given pDTM. Will return true if it has found one or more Tries to find the given pDTM. Will return true if it has found one or more

44
Units/MMLCore/dtmutil.pas
View File

@ -31,13 +31,13 @@ uses
Classes, SysUtils, MufasaTypes; Classes, SysUtils, MufasaTypes;
Function pDTMToTDTM(Const DTM: pDTM): TDTM; function pDTMToTDTM(Const DTM: pDTM): TDTM;
Function tDTMTopDTM(Const DTM: TDTM): pDTM; function tDTMTopDTM(Const DTM: TDTM): pDTM;
Procedure PrintpDTM(const aDTM : pDTM); procedure PrintpDTM(const aDTM : pDTM);
procedure initdtm(out d: pdtm; len: integer); procedure initdtm(out d: pdtm; len: integer);
function ValidMainPointBox(var dtm: pDTM; const x1, y1, x2, y2: Integer): TBox; function ValidMainPointBox(var dtm: pDTM; const x1, y1, x2, y2: Integer): TBox;
Function ValidMainPointBoxRotated(var dtm: pDTM; const x1, y1, x2, y2: Integer;const function ValidMainPointBoxRotated(var dtm: pDTM; const x1, y1, x2, y2: Integer;const
sAngle, eAngle, aStep: Extended): TBox; sAngle, eAngle, aStep: Extended): TBox;
function DTMConsistent(const dtm: pdtm): boolean; function DTMConsistent(const dtm: pdtm): boolean;
procedure NormalizeDTM(var dtm: pdtm); procedure NormalizeDTM(var dtm: pdtm);
@ -55,7 +55,6 @@ implementation
uses math,MufasaBase; uses math,MufasaBase;
procedure RotatePoints_(Var P: TPointArray; A, cx, cy: Extended); procedure RotatePoints_(Var P: TPointArray; A, cx, cy: Extended);
Var Var
I, L: Integer; I, L: Integer;
CosA,SinA : extended; CosA,SinA : extended;
@ -99,7 +98,7 @@ begin
d.bp[i] := False; d.bp[i] := False;
end; end;
Procedure PrintpDTM(const aDTM : pDTM); procedure PrintpDTM(const aDTM : pDTM);
var var
i : integer; i : integer;
begin; begin;
@ -111,7 +110,7 @@ begin;
mDebugLn('SubPoint['+IntToStr(I) + '] ' + inttostr(aDTM.p[i].x) + ', ' + inttostr(aDTM.p[i].y) + ' col: ' + inttostr(aDTM.c[i]) + ', tol: ' + inttostr(aDTM.t[i]) + '; ashape ' + inttostr(aDTM.ash[i]) + ' asize ' + inttostr(aDTM.asz[i]) + ', Bad Point: ' + BoolToStr(aDTM.bp[i])); mDebugLn('SubPoint['+IntToStr(I) + '] ' + inttostr(aDTM.p[i].x) + ', ' + inttostr(aDTM.p[i].y) + ' col: ' + inttostr(aDTM.c[i]) + ', tol: ' + inttostr(aDTM.t[i]) + '; ashape ' + inttostr(aDTM.ash[i]) + ' asize ' + inttostr(aDTM.asz[i]) + ', Bad Point: ' + BoolToStr(aDTM.bp[i]));
end; end;
Function pDTMToTDTM(Const DTM: pDTM): TDTM; function pDTMToTDTM(Const DTM: pDTM): TDTM;
Var Var
Temp: TDTMPointDef; Temp: TDTMPointDef;
@ -147,19 +146,17 @@ End;
Converts a TDTM to a pDTM. Converts a TDTM to a pDTM.
/\} /\}
Function tDTMTopDTM(Const DTM: TDTM): pDTM; function tDTMTopDTM(Const DTM: TDTM): pDTM;
var
Var
//Temp: TDTMPointDef;
I: Integer; I: Integer;
begin
Begin Result.l := Length(DTM.SubPoints) + 1; //The mainpoint is in a different structure
SetLength(Result.p, Length(DTM.SubPoints) + 1); SetLength(Result.p, Result.l);
SetLength(Result.c, Length(DTM.SubPoints) + 1); SetLength(Result.c, Result.l);
SetLength(Result.t, Length(DTM.SubPoints) + 1); SetLength(Result.t, Result.l);
SetLength(Result.asz, Length(DTM.SubPoints) + 1); SetLength(Result.asz, Result.l);
SetLength(Result.ash, Length(DTM.SubPoints) + 1); SetLength(Result.ash, Result.l);
SetLength(Result.bp, Length(DTM.SubPoints) + 1); SetLength(Result.bp, Result.l);
Result.p[0].x := DTM.MainPoint.x; Result.p[0].x := DTM.MainPoint.x;
Result.p[0].y := DTM.MainPoint.y; Result.p[0].y := DTM.MainPoint.y;
@ -168,7 +165,7 @@ Begin
Result.asz[0] := DTM.MainPoint.AreaSize; Result.asz[0] := DTM.MainPoint.AreaSize;
Result.ash[0] := DTM.MainPoint.AreaShape; Result.ash[0] := DTM.MainPoint.AreaShape;
For I := 1 To Length(DTM.SubPoints) Do // High + 1 = Length For I := 1 To Result.l - 1 Do // High + 1 = Length
Begin Begin
Result.p[I].x := DTM.SubPoints[I - 1].x; Result.p[I].x := DTM.SubPoints[I - 1].x;
Result.p[I].y := DTM.SubPoints[I - 1].y; Result.p[I].y := DTM.SubPoints[I - 1].y;
@ -178,11 +175,10 @@ Begin
Result.ash[I] := DTM.SubPoints[I - 1].AreaShape; Result.ash[I] := DTM.SubPoints[I - 1].AreaShape;
End; End;
Result.l := length(Result.p);
setlength(result.bp, result.l); setlength(result.bp, result.l);
for i := 0 to result.l -1 do for i := 0 to result.l -1 do
result.bp[i] := false; result.bp[i] := false;
End; end;
{ TODO: Check if bounds are correct? } { TODO: Check if bounds are correct? }
function DTMConsistent(const dtm: pdtm): boolean; function DTMConsistent(const dtm: pdtm): boolean;
@ -229,7 +225,7 @@ begin
dtm.p[0] := dtm.p[0] - dtm.p[0]; //Point(0,0); dtm.p[0] := dtm.p[0] - dtm.p[0]; //Point(0,0);
end; end;
Function ValidMainPointBox(var dtm: pDTM; const x1, y1, x2, y2: Integer): TBox; function ValidMainPointBox(var dtm: pDTM; const x1, y1, x2, y2: Integer): TBox;
var var
i: Integer; i: Integer;
@ -256,7 +252,7 @@ begin
Result.y2 := y2 - b.y2; Result.y2 := y2 - b.y2;
end; end;
Function ValidMainPointBoxRotated(var dtm: pDTM; const x1, y1, x2, y2: Integer; function ValidMainPointBoxRotated(var dtm: pDTM; const x1, y1, x2, y2: Integer;
const sAngle, eAngle, aStep: Extended): TBox; const sAngle, eAngle, aStep: Extended): TBox;
var var

46
Units/MMLCore/finder.pas
View File

@ -85,9 +85,9 @@ type
function FindDeformedBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; out accuracy: Extended): Boolean; function FindDeformedBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; out accuracy: Extended): Boolean;
function FindDTM(const DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean; function FindDTM(const DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
function FindDTMs(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2, maxToFind: Integer): Boolean; function FindDTMs(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2 : integer; maxToFind: Integer = 0): Boolean;
function FindDTMRotated(const DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended; Alternating : boolean): Boolean; function FindDTMRotated(const DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended; Alternating : boolean): Boolean;
function FindDTMsRotated(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray; maxToFind: Integer; Alternating : boolean): Boolean; function FindDTMsRotated(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray;Alternating : boolean; maxToFind: Integer = 0): Boolean;
//Donno //Donno
function GetColors(const Coords: TPointArray): TIntegerArray; function GetColors(const Coords: TPointArray): TIntegerArray;
// tol speeds // tol speeds
@ -1923,6 +1923,7 @@ begin
Exit(False); Exit(False);
end; end;
//MaxToFind, if it's < 1 it won't stop looking
function TMFinder.FindDTMs(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2, maxToFind: Integer): Boolean; function TMFinder.FindDTMs(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2, maxToFind: Integer): Boolean;
var var
// Colours of DTMs // Colours of DTMs
@ -1967,10 +1968,7 @@ begin
// Is the area valid? // Is the area valid?
DefaultOperations(x1, y1, x2, y2); DefaultOperations(x1, y1, x2, y2);
if not DTMConsistent(dtm) then if not DTMConsistent(dtm) then
begin raise Exception.CreateFmt('FindDTMs: DTM[%s] is not consistent.', [DTM.n]);
raise Exception.CreateFmt('FindDTMs: DTM is not consistent.', []);
Exit;
end;
// Get the area we should search in for the Main Point. // Get the area we should search in for the Main Point.
MA := ValidMainPointBox(DTM, x1, y1, x2, y2); MA := ValidMainPointBox(DTM, x1, y1, x2, y2);
@ -2087,7 +2085,7 @@ var
P: TPointArray; P: TPointArray;
F: T2DExtendedArray; F: T2DExtendedArray;
begin begin
FindDTMsRotated(dtm, P, x1, y1, x2, y2, sAngle, eAngle, aStep, F, 1,Alternating); FindDTMsRotated(dtm, P, x1, y1, x2, y2, sAngle, eAngle, aStep, F,Alternating,1);
if Length(P) = 0 then if Length(P) = 0 then
exit(false); exit(false);
aFound := F[0][0]; aFound := F[0][0];
@ -2096,7 +2094,7 @@ begin
Exit(True); Exit(True);
end; end;
function TMFinder.FindDTMsRotated(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray; maxToFind: Integer; Alternating : boolean): Boolean; function TMFinder.FindDTMsRotated(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray;Alternating : boolean; maxToFind: Integer): Boolean;
var var
DTMRot: pDTM; DTMRot: pDTM;
// Colours of DTMs // Colours of DTMs
@ -2146,11 +2144,8 @@ var
begin begin
// Is the area valid? // Is the area valid?
DefaultOperations(x1, y1, x2, y2); DefaultOperations(x1, y1, x2, y2);
if not DTMConsistent(DTM) then if not DTMConsistent(dtm) then
begin raise Exception.CreateFmt('FindDTMs: DTM[%s] is not consistent.', [DTM.n]);
raise Exception.CreateFmt('FindDTMsRotated: DTMRot is not consistent.', []);
Exit;
end;
NormalizeDTM(DTM); NormalizeDTM(DTM);
@ -2185,6 +2180,10 @@ begin
for i := 0 to DTM.l - 1 do for i := 0 to DTM.l - 1 do
ColorToHSL(DTM.c[i],hh[i],ss[i],ll[i]); ColorToHSL(DTM.c[i],hh[i],ss[i],ll[i]);
{We create a kinda 'fake' rotated DTM. This dtm only has points + len, no other crap.
Since this other 'crap' equals the original DTM, no need to copy that!}
DTMRot.l := DTM.l;
GetToleranceSpeed2Modifiers(hMod, sMod); GetToleranceSpeed2Modifiers(hMod, sMod);
ccts := CTS; ccts := CTS;
@ -2203,16 +2202,19 @@ begin
s := sAngle; s := sAngle;
while s < eAngle do while s < eAngle do
begin begin
DTMRot := RotateDTM(DTM, s); // DTMRot := RotateDTM(DTM, s);
//Rotate the DTMRot, the rest is just like FindDTMs DTMRot.p := RotatePoints(DTM.p,s,0,0);
//DTMRot now has the same points as the original DTM, just rotated!
//The other stuff in the structure doesn't matter, as it's the same as the original DTM..
//So from now on if we want to see what 'point' we're at, use DTMRot.p, for the rest just use the original DTM
MA := ValidMainPointBox(DTMRot, x1, y1, x2, y2); MA := ValidMainPointBox(DTMRot, x1, y1, x2, y2);
//CD starts at 0,0.. We must adjust the MA, since this is still based on the xs,ys,xe,ye box. //CD(ClientData) starts at 0,0.. We must adjust the MA, since this is still based on the xs,ys,xe,ye box.
MA.x1 := MA.x1 - x1; MA.x1 := MA.x1 - x1;
MA.y1 := MA.y1 - y1; MA.y1 := MA.y1 - y1;
MA.x2 := MA.x2 - x1; MA.x2 := MA.x2 - x1;
MA.y2 := MA.y2 - y1; MA.y2 := MA.y2 - y1;
//MA is now fixed to the new (0,0) box... //MA is now fixed to the new (0,0) box...
for yy := MA.y1 to MA.y2 do //Coord of the mainpoint in the search area for yy := MA.y1 to MA.y2 do //(xx,yy) is now the coord of the mainpoint in the search area
for xx := MA.x1 to MA.x2 do for xx := MA.x1 to MA.x2 do
begin begin
//Mainpoint can have area size as well, so we must check that just like any subpoint. //Mainpoint can have area size as well, so we must check that just like any subpoint.
@ -2220,10 +2222,10 @@ begin
begin //change to use other areashapes too. begin //change to use other areashapes too.
Found := false; Found := false;
//With area it can go out of bounds, therefore this max/min check //With area it can go out of bounds, therefore this max/min check
StartX := max(0,xx - DTMRot.asz[i] + DTMRot.p[i].x); StartX := max(0,xx - DTM.asz[i] + DTMRot.p[i].x);
StartY := max(0,yy - DTMRot.asz[i] + DTMRot.p[i].y); StartY := max(0,yy - DTM.asz[i] + DTMRot.p[i].y);
EndX := Min(Ma.x2,xx + DTMRot.asz[i] + DTMRot.p[i].x); EndX := Min(Ma.x2,xx + DTM.asz[i] + DTMRot.p[i].x);
EndY := Min(ma.y2,yy + DTMRot.asz[i] + DTMRot.p[i].y); EndY := Min(ma.y2,yy + DTM.asz[i] + DTMRot.p[i].y);
for xxx := StartX to EndX do //The search area for the subpoint for xxx := StartX to EndX do //The search area for the subpoint
begin begin
for yyy := StartY to EndY do for yyy := StartY to EndY do
@ -2234,7 +2236,7 @@ begin
// Checking point i now. (Store that we matched it) // Checking point i now. (Store that we matched it)
ch[xxx][yyy]:= ch[xxx][yyy] or (1 shl i); ch[xxx][yyy]:= ch[xxx][yyy] or (1 shl i);
if ColorSame(ccts,DTMRot.t[i],clR[i],clG[i],clB[i],cd[yyy][xxx].R, cd[yyy][xxx].G, cd[yyy][xxx].B,hh[i],ss[i],ll[i],hmod,smod) then if ColorSame(ccts,DTM.t[i],clR[i],clG[i],clB[i],cd[yyy][xxx].R, cd[yyy][xxx].G, cd[yyy][xxx].B,hh[i],ss[i],ll[i],hmod,smod) then
b[xxx][yyy] := b[xxx][yyy] or (1 shl i); b[xxx][yyy] := b[xxx][yyy] or (1 shl i);
end; end;

2
Units/MMLCore/mufasatypes.pas
View File

@ -100,7 +100,7 @@ type
add seperate tpa or boolean array for every point that is to be matched ? add seperate tpa or boolean array for every point that is to be matched ?
} }
pDTM = packed record pDTM = record
l: Integer; l: Integer;
p: TPointArray; p: TPointArray;
c, t, asz, ash: TIntegerArray; c, t, asz, ash: TIntegerArray;