moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2025-01-30 14:50:18 -05:00
Code Issues Releases Wiki Activity

Bitmap masks added. Little mistake in the RowCalcs, fixed it. RetData now also has a RowLen property.

Browse Source 
Added Paths (ScriptPath / AppPath);

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@143 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond 2009-10-20 19:48:18 +00:00
parent 303851af92
commit dd3d202b44
12 changed files with 302 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Projects/SAMufasaGUI/testunit.lrs
View File

@ -1,3 +1,5 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TForm1','FORMDATA',[
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#207#0#6'Height'#3')'#2#3'Top'#3#196#0#5'W'
+'idth'#3#211#2#13'ActiveControl'#7#8'SynEdit1'#7'Caption'#6#9'Mufasa v2'#12

43
Projects/SAMufasaGUI/testunit.pas
View File

@ -23,7 +23,7 @@
unit TestUnit;
{$Undefine ProcessMessages} //Define this for processmessages in ThreadSafeCall
{$Undef ProcessMessages} //Define this for processmessages in ThreadSafeCall
{$mode objfpc}{$H+}
interface
@ -100,7 +100,7 @@ type
procedure ToTray(Sender: TObject);
procedure Undo(Sender: TObject);
private
ScriptPath : string;//The path to the saved/opened file currently in the SynEdit
ScriptFile : string;//The path to the saved/opened file currently in the SynEdit
StartText : string;//The text synedit holds upon start/open/save
ScriptName : string;//The name of the currently opened/saved file.
ScriptDefault : string;//The default script e.g. program new; begin end.
@ -115,11 +115,13 @@ type
function SaveCurrentScriptAs : boolean;
function CanExitOrOpen : boolean;
function ClearScript : boolean;
procedure run;
end;
const
WindowTitle = 'Mufasa v2 - %s';//Title, where %s = the place of the filename.
var
Form1: TForm1;
MainDir : string;
CurrentSyncInfo : TSyncInfo;//We need this for SafeCallThread
implementation
@ -128,20 +130,23 @@ uses
{ TForm1 }
procedure Run;
procedure TForm1.Run;
Var
MMLPSThread : TMMLPSThread;
begin
CurrentSyncInfo.SyncMethod:= @Form1.SafeCallThread;
CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread;
MMLPSThread := TMMLPSThread.Create(True,@CurrentSyncInfo);
MMLPSThread.SetPSScript(Form1.SynEdit1.Lines.Text);
MMLPSThread.SetDebug(Form1.Memo1);
MMLPSThread.SetPSScript(Self.SynEdit1.Lines.Text);
MMLPSThread.SetDebug(Self.Memo1);
if ScriptFile <> '' then
MMLPSThread.SetPaths( ExtractFileDir(ScriptFile) + DS,MainDir +DS)
else
MMLPSThread.SetPaths('',MainDir + DS);
// This doesn't actually set the Client's MWindow to the passed window, it
// only copies the current set window handle.
MMLPSThread.Client.MWindow.SetWindow(Form1.Window);
MMLPSThread.Client.MWindow.SetWindow(Self.Window);
MMLPSThread.Resume;
@ -330,9 +335,9 @@ begin;
StartText := SynEdit1.Lines.text;
ScriptName:= ExtractFileNameOnly(FileName);
WriteLn('Script name will be: ' + ScriptName);
ScriptPath:= FileName;
ScriptFile:= FileName;
StatusBar.Panels[0].Text:= ScriptName;
StatusBar.Panels[1].text:= ScriptPath;
StatusBar.Panels[1].text:= FileName;
Self.Caption:= Format(WindowTitle,[ScriptName]);
ScriptChanged := false;
Result := True;
@ -344,11 +349,11 @@ end;
function TForm1.SaveCurrentScript: boolean;
begin
Result := (ScriptPath <> '');
Result := (ScriptFile <> '');
if Result then
begin;
ScriptChanged := false;
SynEdit1.Lines.SaveToFile(ScriptPath);
SynEdit1.Lines.SaveToFile(ScriptFile);
StartText:= SynEdit1.Lines.Text;
end
else
@ -365,13 +370,13 @@ begin
begin;
if ExtractFileExt(FileName) = '' then
begin;
ScriptPath := FileName + '.mufa';
ScriptFile := FileName + '.mufa';
end else
ScriptPath := FileName;
SynEdit1.Lines.SaveToFile(ScriptPath);
ScriptName:= ExtractFileNameOnly(ScriptPath);
ScriptFile := FileName;
SynEdit1.Lines.SaveToFile(ScriptFile);
ScriptName:= ExtractFileNameOnly(ScriptFile);
StatusBar.Panels[0].Text:= ScriptName;
StatusBar.Panels[1].text := ScriptPath;
StatusBar.Panels[1].text := ScriptFile;
Self.Caption:= Format(WindowTitle,[ScriptName]);
WriteLn('Script name will be: ' + ScriptName);
Result := True;
@ -381,7 +386,7 @@ begin
end;
if result then
begin;
Writeln('Succesfully saved: ' + ScriptPath);
Writeln('Succesfully saved: ' + ScriptFile);
StartText:= SynEdit1.Lines.Text;
SynEdit1.MarkTextAsSaved;
ScriptChanged := false;
@ -405,7 +410,7 @@ function TForm1.ClearScript: boolean;
begin
if CanExitOrOpen then
begin;
ScriptPath:= '';
ScriptFile:= '';
ScriptName:= 'Untitled';
StartText:= ScriptDefault;
SynEdit1.Lines.Text:= ScriptDefault;

77
Tests/PS/BmpTest.mufa Normal file
View File

@ -0,0 +1,77 @@
program new;
//http://www.hawaiisunshine.org/wp-content/uploads/2008/12/sunshine1.jpg
var
Bmp : integer;
x,y : integer;
w,h : integer;
begin
Bmp := BitmapFromString(37, 32, 'beNqFl3lwVuUVxp93veu3f1' +
'lI+EKCLCkIAuI6oIBl0ylWweJerSm2atAaUJYgZCMLBAKyTSAh+w4' +
'ERKnUpWoXERSBjtailDVACLS17Tj+13NvpB3tTHvnzOTOzb3vL+c5' +
'azIGaIDMYMwQ3BBSkSkD4J4xCa4gNKQBZTClTS5tMBNQgAAY6C3mG' +
'cN/zP/Wf0o3373oK0mfM8/E1UMMAa0YmZKQ4pvz6DUHzAJM3wwmpH' +
'/6t1j/D3f1He/Xyj/HFQgzhIEQEAHiQDIwAEjzbrjrQX2c7yNJwDn' +
'/5vh+Tb5l/3Vx77mhdFDLEEMMSPdtMDAGmMAwXWOWxWfb4s6APT4a' +
'S5iBCDgRLT8KnjhcEJEJIgvP/ieOccPgZpDrsO/FIGAUcI8TeMwJP' +
'heOLI/FVkZj5YFAuWEscANTw8lDnEgcMgQeBDd9hQXjQggu6ack+z' +
'b0u5enHpAEZADXA3MDwSWZgwtSB5aG4+VmoBxGOfgqYC2wVNrjIaJ' +
'gQV/nKBdh7rnpMPKUecnGhCI044xdzZ9+5tV40ZXMPenIo/ujumRk' +
'5oahA1cHCIEqsCqINZCV3Fpjhsp08CnDHe5RVAw86oeVLOoHN8W/T' +
'+YywpWnMPfj2h/d/iTm3xBHAHcHUDT2mi3jrqmISgJVK2yXvFbqjd' +
'ysYGah4S5xQ08b1t1CDZMi4COygKHANcBYYHbmwEUzpg33JUoSgiB' +
'aCWFKP+P75ca/U3j9iOH7pk2pHpRaAmwSaHJ0NbCRnkuxynFXhEN5' +
'SbHHosGpEsN9FzJtjBYYDcwCirPSm267pWbSLQuGDxrXn7rKO57O5' +
'dqyAuGrGeuB/CrjHZmZG6TYANQL3qpEE9g2YJvQa4ReBPYT4IfAFD' +
'+sQ/34kl93Glg1etBrk8Z1j8hYb2MpkGfh8RCboL1kiynpWK6fuRa' +
'D5lDcq2mvfMnaQnaj4g0AWSPQDNYIVSusddJ+ial5wA+AicANPnEa' +
'R/61SR3Tx+y+dXBnltGditfT+asJ/Up2rOumYQsTkZFAKqmtXC8Bj' +
'TiDzWFyD6p9KN8C1ADthuwyDWI1gDfB2OQJa20IRMqD4YWWkcNxP/' +
'AghfW6RNvYAV3XxbqGGjvT8Uoy9sWxN4LuKHYPjuy8YcSiRNpNnqr' +
'U+Dwih61AUfRwXt9iYksImy1slqiVvNV0W5TTCN0s3QZt15r2Jq2r' +
'tFxrmRuToo2J+GuDgntTsSMV3ZnYl403RuLd7+H9bH1omLsngpaYU' +
'2xbpMa1XgkrB5YFbVLieKnqFyNnm4LYFlI1rrFV6Rqu67nRLO1WaT' +
'UKUcdQyyiOaHB4V2rwjczIwSzzyBB5cKTxu9HGW9epX13L9w/Bmxn' +
'YH8EuEw0C9LctCUTvZeYQIAFGNRL2mx6lK/PTZZuFelc32FY1RL2y' +
'Opxwo9KtpqwXaLVRw9EewtvZgXdGhI7cmPLJGPvoSHZsvHtonLsvC' +
'3sHYV9CdATRotDAUc1QpTg5+LwVeFhY06GvB0v4zSrsdzxK0AaFRi' +
'VJxiZltxgu3Wynhxo7Y6gWaIvi9+OtD28N/mFy0rHbQ0dvlp9OtA6' +
'M5m8Nwfujo+9lx7tjssNlDRLbODYxrBMoN8VyQy+Uep7QD7uhmZY9' +
'0bFH2TrKvBpp9Ux0SqddOp6MhtFgojMJNQ5aUnFkWuCTWeHDM8zj9' +
'yV/MFUemi4/nGq9c714e4T1wai0NwdGWzij2qlnbCvDyxxrBCoUVi' +
'oUKpGv9S9Md54TfiASnRx0MihNgU6OLq7aBaWlbhSq3VWdcTTFURv' +
'FRzPNM48nfzLH/GyudXS2PnAXfjMDb07EgcmhwxPS96W7LZwKR20H' +
'q4PaygTh1nKUMawkAwo5WwDkcvNR05miJI0Y6khdFu+0dLMWJGmTJ' +
'ZuDaI5jWxgfTTMv5Aw4di+OPyRPPeES6+hs/s4d+O33xcczUt8dG2' +
'20vApqFW4DrBrwanAqnyoGaoPFQBFQwHg+RJ60HxHqNmpHAPX2Nhf' +
'0IQnYEjCagtgeQEMc799u9s7LOPlj5/ij7OQT+sgckB27j308S5x8' +
'MHHwtkhzCHUSrVJR1dTB2NLf95gn5iqGUoYSqEKmXxLmAsP9Edh4v' +
'yPRHGlwsN0CgVqisi6E1nT8+mbz77mje3KSTzyuLueFT+Sww3Pw5x' +
'zj0wdkz2MpX8yKv56FOk5+oY1zcrAabCPlJEeFRKn0WKXQpbCL4OZ' +
'B/cy0ZgLZ/tRwOSMcsTpSjLYUTvF6fRy/kjvy/FNpPU8Hr7wY+/xJ' +
'fJaDSy+ETj9jnvpp4G9PZu8fhjqNLgcdCnXUacFqhNoo2RrKEIEij' +
'kJPTFkCawXsZxnPsa07GM/yaoFpqbrjRnOAt8RY5yDszMb5nw+8mB' +
'c785w+MR+nntdfzBe9S8PHn8YXubi8IOXAJLc7Dc022ilvJSNWLcR' +
'mkhFYTU5xFAsUS1GidLEw86V+VuMhjQngaV7NKSizM8DbQ6otiXVk' +
'4eN73MsvppxZyE++gLP54vM8nF8WOLlAnV9sn1moz82PvzoCHTFeb' +
'6DZZNR2SMmtEFvA14Othp+T3MNRFazgaonk8w08aOAmyBRv/hg0ll' +
'ps7Egy25LRORSXnx98eVmkn9Vb5J5cLC4VBk7koe+l0KUl8cNzDKr' +
'EtoifWtRGpIcj1zYzsY68A8o5SgVKhCgSvAByMeO5ms3VfIw/8Q1O' +
'iyQ6w+hON5oHYP8t+HJZRu8yeXY5egr1uQLrQoF9Zom8sFReWGRfX' +
'pixewwaY9gRl5TMdQJ1Smxl7GVgAxhtMpUMFQJlHpEVgxeCLwbLVf' +
'JeybP9BSAgJE3nPenoTAMp+dmjQfLiYhEuluNsiTqzwuwpNM/ms8s' +
'rjCuLw6dz0uoHoD2GPclWm8Opl24nnCAZaavBGsJxD0fmVwEv8nCC' +
'Vo47ucjqX6X8WtiTgdYB+OWN5FriUqE6vxI9FThVzM6V2KeXo6/Yu' +
'LLc+Ud+4uA0pykZXXHsDMtmE9sYtgpsFp6MhFvrV1ylj6sA4TwHl8' +
'J4yg5OBhvo40hPGr67MrF3FP74kPPP0uS+Mpwtw6lSnC7DuTJ1vlh' +
'cKjC+XB7tm5+2ezi6UrArKjqoSA1s12yTn5DrOa/irNLvlmSruYcr' +
'BSuDXMasHCdyo19xUX9VnsSwKxsf3IWvChJ/WWn0VXqgUyTmKpwpw' +
'V8rndML8XXB4D/NjdRT1JJVd1S3GWixZKOjN/gaVknRD1pLpSf8CF' +
'KKghMuXwYecbx1gja0VO6tOvcZ4r0p6FuQ9HVFvHel59qFtR7rdDn' +
'61grKmUtLA725CYpsawy7U+2dAfKO1SlUc6//V/lOkWs05ip9SdcJ' +
'bwf2cMxcZATuD8dp3qULkJ60vD0TC/XkZnxVmtJbiIskYDlOFuN8J' +
'etZjd5V6FmGvkVJh+6ym1PQSgtJ3Njh0mTktcIbbV6G+E4Ra4Pma/' +
'xNm4T1vGOqVNp5ZnCashLeWPf+47gnwIv/BWSck+g=');
GetClientDimensions(w,h);
if FindBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,25) then
MoveMouse(x,y);
end.

22
Tests/PS/MaskTest.mufa Normal file
View File

@ -0,0 +1,22 @@
program new;
//http://nl.wikipedia.org/wiki/Lily_Allen
var
Bmp : integer;
Mask : TMask;
x,y : integer;
i, ii : integer;
w,h : integer;
begin
Bmp := BitmapFromString(107, 19, 'beNrtVkEOgCAM8/+fxoOJUYG' +
'uWwZKbE9KtmYrHbBtgiAIgpCOckFiopdtZr/j2HhynBjYjmntJxaW' +
'6BwJWC8eH6QU15gz0Zx9vFgX0Iwhs0CASRUW8CFmioB1JFisA5qRI' +
'KvJQNKa5mEcyAhoauI6N8ymAlkxWpdtwgL2bhPXCJc7+E7JLNJsgG' +
'qQgL1jhHwX4VJdBsNZMbN5D//m/ob5XzwDp40wfg/jW9g024hbuPd' +
'ritabVqaAj7zYVyxg9fol4M8FFG7YAfIG00k=');
Mask := CreateBitmapMask(Bmp);
GetClientDimensions(w,h);
// if FindBitmapMaskTolerance(Bmp,x,y,0, 0,w-1, h-1,1,5) then
if FindMaskTolerance(Mask,x,y,0, 0,w-1, h-1,1,5) then
MoveMouse(x,y);
end.

5
Tests/PS/PathTest.mufa Normal file
View File

@ -0,0 +1,5 @@
program new;
begin
Writeln(AppPath);
Writeln(ScriptPath);
end.

16
Units/MMLAddon/PSInc/Wrappers/bitmap.inc
View File

@ -231,3 +231,19 @@ begin;
Bmp[bitmap].Posterize(Bmp[result],po);
end;
end;
function CreateBitmapMask(Bitmap : integer) : TMask;
begin;
result := CurrThread.Client.MBitmaps.Bmp[Bitmap].CreateTMask;
end;
function FindMaskTolerance(mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
begin;
result := CurrThread.Client.MFinder.FindBitmapMaskTolerance(Mask,x,y,xs,ys,xe,ye,tolerance,contourtolerance);
end;
function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
begin;
Writeln('Better be using FindMaskTolerance in combination with CreateBitmapMask, more efficient.');
with CurrThread.Client do
result := MFinder.FindBitmapMaskTolerance(MBitmaps.bmp[mask].CreateTMask,x,y,xs,ys,xe,ye,tolerance,contourtolerance);
end;

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

@ -21,9 +21,12 @@
PSCompile.inc for the Mufasa Macro Library
}
Sender.Comp.AddConstantN('AppPath','string').SetString(CurrThread.AppPath);
Sender.Comp.AddConstantN('ScriptPath','string').SetString(CurrThread.ScriptPath);
Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer');
Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
Sender.Comp.AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : integer; W,H : integer;end;');
Sender.Comp.AddTypes('TDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
@ -127,3 +130,6 @@ Sender.AddFunction(@GreyScaleBitmap,'function GreyScaleBitmap(bitmap : integer)
Sender.AddFunction(@BrightnessBitmap,'function BrightnessBitmap(Bitmap,br : integer) : integer;');
Sender.AddFunction(@ContrastBitmap,'function ContrastBitmap(bitmap : integer; co : extended) : integer;');
Sender.AddFunction(@PosterizeBitmap,'function PosterizeBitmap(Bitmap : integer; po : integer) : integer;');
Sender.AddFunction(@CreateBitmapMask,'function CreateBitmapMask(Bitmap : integer) : TMask;');
Sender.AddFunction(@FindMaskTolerance,'function FindMaskTolerance(mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
Sender.AddFunction(@FindBitmapMaskTolerance,'function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');

9
Units/MMLAddon/mmlpsthread.pas
View File

@ -47,6 +47,8 @@ type
procedure PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser; const Active: Boolean;
const DirectiveName, DirectiveParam: string; var Continue: Boolean);
private
ScriptPath, AppPath : string;
protected
DebugTo : TMemo;
PluginsToload : Array of integer;
@ -65,6 +67,7 @@ type
SyncInfo : PSyncInfo; //We need this for callthreadsafe
procedure SetPSScript(Script : string);
procedure SetDebug( Strings : TMemo );
procedure SetPaths(ScriptP,AppP : string);
constructor Create(CreateSuspended: Boolean; TheSyncInfo : PSyncInfo);
destructor Destroy; override;
end;
@ -315,6 +318,12 @@ begin
DebugTo := Strings;
end;
procedure TMMLPSThread.SetPaths(ScriptP, AppP: string);
begin
AppPath:= AppP;
ScriptPath:= ScriptP;
end;
{ Include stuff here? }

39
Units/MMLCore/bitmaps.pas
View File

@ -71,6 +71,7 @@ type
procedure Invert;
procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);overload;
procedure Posterize(Po : integer);overload;
function CreateTMask : TMask;
constructor Create;
destructor Destroy;override;
end;
@ -475,10 +476,8 @@ var
PtrRet : TRetData;
Rows : integer;
begin
Self.ValidatePoint(xs,ys);
Self.ValidatePoint(xe,ye);
wi := xe-xs + 1;
hi := ye-ys + 1;
wi := Min(xe-xs + 1,Self.w);
hi := Min(ye-ys + 1,Self.h);
PtrRet := TMWindow(MWindow).ReturnData(xs,ys,wi,hi);
for y := 0 to (hi-1) do
Move(PtrRet.Ptr[y * (wi + PtrRet.IncPtrWith)], FData[y * self.w],wi * SizeOf(TRGB32));
@ -754,6 +753,38 @@ begin
end;
end;
function TMufasaBitmap.CreateTMask: TMask;
var
x,y : integer;
dX,dY : integer;
begin
Result.BlackHi:= -1;
Result.WhiteHi:= -1;
Result.W := Self.Width;
Result.H := Self.Height;
SetLength(result.Black,w*h);
SetLength(result.White,w*h);
dX := w-1;
dY := h-1;
//Search it like | | | | | instead of horizontal -> for X loop first.
for x := 0 to dX do
for y := 0 to dY do
//Check for non-white/black pixels? Not for now atleast.
if FData[y*w+x].r = 255 then
begin;
inc(Result.WhiteHi);
Result.White[Result.WhiteHi].x := x;
Result.White[Result.WhiteHi].y := y;
end else
begin;
inc(Result.BlackHi);
Result.Black[Result.BlackHi].x := x;
Result.Black[Result.BlackHi].y := y;
end;
SetLength(result.Black,Result.BlackHi+1);
SetLength(result.White,Result.WhiteHi+1);
end;
constructor TMBitmaps.Create(Owner: TObject);

99
Units/MMLCore/finder.pas
View File

@ -27,6 +27,7 @@ unit finder;
interface
{$define CheckAllBackground}//Undefine this to only check the first white point against the background (in masks).
uses
Classes, SysUtils,bitmaps, MufasaTypes; // Types
@ -59,6 +60,9 @@ type
function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tol: Integer): Boolean;
function FindColorsSpiralTolerance(x, y: Integer; var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;
function FindColors(var TPA: TPointArray; Color, xs, ys, xe, ye: Integer): Boolean;
//Mask
function FindBitmapMaskTolerance(mask: TMask; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
procedure CheckMask(Mask : TMask);
//Bitmap functions
function FindBitmap(bitmap: TMufasaBitmap; var x, y: Integer): Boolean;
function FindBitmapIn(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
@ -142,11 +146,8 @@ var
I : integer;
begin;
setlength(result,RowCount);
for i := 0 to RowCount - 1do
begin;
result[i] := ReturnData.Ptr;
inc(ReturnData.Ptr,ReturnData.IncPtrWith);
end;
for i := 0 to RowCount - 1 do
result[i] := ReturnData.Ptr + ReturnData.RowLen * i;
end;
function CalculateRowPtrs(Bitmap : TMufasaBitmap) : TPRGB32Array;overload;
@ -155,7 +156,7 @@ var
begin;
setlength(result,Bitmap.Height);
for i := 0 to Bitmap.Height - 1 do
result[i] := Bitmap.FData + Bitmap.Width;
result[i] := Bitmap.FData + Bitmap.Width * i;
end;
constructor TMFinder.Create(aClient: TObject);
@ -671,6 +672,92 @@ begin
TClient(Client).MWindow.FreeReturnData;
end;
//Only works with CTS 1 for now.. Since Colorsame doesn't return a boolean :-(
//We do not check whether every white pixel is in tol range with every other white pixel..
function TMFinder.FindBitmapMaskTolerance(mask: TMask; var x, y: Integer; xs,
ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
var
MainRowdata : TPRGB32Array;
PtrData : TRetData;
MaskW,MaskH : integer;
CheckerWhite,CheckerBlack,CurrWhite,CurrBlack: TRGB32;
i,ii : integer;
dX, dY, xx, yy: Integer;
label NotFoundMask;
//Don't know if the compiler has any speed-troubles with goto jumping in nested for loops.
begin
Result := false;
// checks for valid xs,ys,xe,ye? (may involve GetDimensions)
DefaultOperations(xs,ys,xe,ye);
//Check the mask.
CheckMask(Mask);
// calculate delta x and y
dX := xe - xs;
dY := ye - ys;
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
//Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
//Get the 'fixed' mask size
MaskW := Mask.W;
MaskH := Mask.H;
//Heck our mask cannot be outside the search area
dX := dX - MaskW;
dY := dY - MaskH;
for yy := 0 to dY do
for xx := 0 to dX do
begin;
CheckerWhite := MainRowdata[yy + mask.White[0].y][xx + mask.white[0].x];
CheckerBlack := MainRowdata[yy + mask.Black[0].y][xx + mask.Black[0].x];
//Just check two 'random' points against eachother, might be a time saver in some circumstances.
if (Sqrt(sqr(CheckerWhite.r-CheckerBlack.r) + sqr(CheckerWhite.G-CheckerBlack.G) + sqr(CheckerWhite.b-CheckerBlack.B))
<= ContourTolerance) then //The Tol between the white and black is lower than the minimum difference, so continue with looking!
continue;
for i := 0 to mask.WhiteHi do
begin;
CurrWhite := MainRowdata[yy + mask.White[i].y][xx + mask.white[i].x];
if (Sqrt(sqr(CheckerWhite.r-CurrWhite.r) + sqr(CheckerWhite.G-CurrWhite.G) + sqr(CheckerWhite.b-CurrWhite.B))
> Tolerance) then //The white checkpoint n' this point aren't in the same tol range -> goto nomatch;
goto NotFoundMask;
{$ifdef CheckAllBackground}
for ii := 0 to mask.BlackHi do
begin
CurrBlack := MainRowdata[yy + mask.Black[ii].y][xx + mask.Black[ii].x];
if (Sqrt(sqr(CurrWhite.r-CurrBlack.r) + sqr(CurrWhite.G-CurrBlack.G) + sqr(CurrWhite.b-CurrBlack.B))
<= ContourTolerance) then //The Tol between the white and black is lower than the minimum difference -> goto nomatch;
goto NotFoundMask;
end;
{$endif}
end;
{$ifndef CheckAllBackground}
for ii := 0 to mask.BlackHi do
begin
CurrBlack := MainRowdata[yy + mask.Black[ii].y][xx + mask.Black[ii].x];
if (Sqrt(sqr(CheckerWhite.r-CurrBlack.r) + sqr(CheckerWhite.G-CurrBlack.G) + sqr(CheckerWhite.b-CurrBlack.B))
<= ContourTolerance) then //The Tol between the white and black is lower than the minimum difference -> goto nomatch;
goto NotFoundMask;
end;
{$endif}
//We have found the mask appearntly, otherwise we would have jumped! Gna Gna.
x := xx + xs;
y := yy + ys;
TClient(Client).MWindow.FreeReturnData;
Exit(true);
//Bah not found the mask, lets do nothing and continue!
NotFoundMask:
end;
TClient(Client).MWindow.FreeReturnData;
end;
procedure TMFinder.CheckMask(Mask: TMask);
begin
if (Mask.W < 1) or (Mask.H < 1) or (Mask.WhiteHi < 0) or (Mask.BlackHi < 0) then
raise exception.CreateFMT('Mask is invalid. Width/Height: (%d,%d). WhiteHi/BlackHi: (%d,%d)',[Mask.W,Mask.H,Mask.WhiteHi,Mask.BlackHi]);
end;
function TMFinder.FindBitmap(bitmap: TMufasaBitmap; var x, y: Integer): Boolean;
var
w,h : integer;

10
Units/MMLCore/mufasatypes.pas
View File

@ -32,8 +32,7 @@ uses
Classes, SysUtils,plugins;
const
DS = DirectorySeparator;
var
MainDir : string;
type
TRGB32 = packed record
B, G, R, A: Byte;
@ -43,6 +42,7 @@ type
TRetData = record
Ptr : PRGB32;
IncPtrWith : integer;
RowLen : integer;
end;
TBmpMirrorStyle = (MirrorWidth,MirrorHeight,MirrorLine); //LineMirror is in line x=y;
TTargetWindowMode = (w_BMP, w_Window, w_HDC, w_ArrayPtr, w_XWindow);
@ -54,6 +54,12 @@ type
TExtendedArray = Array of Extended;
T2DExtendedArray = Array of Array of Extended;
{ Mask Types }
TMask = record
White, Black : TPointArray;
WhiteHi,BlackHi : integer;
W,H : integer;
end;
{ DTM Types }
{

5
Units/MMLCore/window.pas
View File

@ -282,6 +282,7 @@ begin
Inc(TmpData, ys * width + xs);
Result.Ptr:= tmpData;
Result.IncPtrWith:= Self.FrozenSize.x - width;
Result.RowLen:= Self.FrozenSize.x;
end else
case Self.TargetMode of
w_BMP :
@ -294,6 +295,7 @@ begin
Inc(TmpData, ys * width + xs);
Result.Ptr := TmpData;
Result.IncPtrWith:= TargetBitmap.Width - width;
Result.RowLen:= TargetBitmap.Width;
end;
w_Window:
begin
@ -301,6 +303,7 @@ begin
BitBlt(Self.DrawBitmap.Canvas.Handle,0,0, width, height, Self.TargetDC, xs,ys, SRCCOPY);
Result.Ptr:= Self.DrawBmpDataPtr;
Result.IncPtrWith:= DrawBmpW - Width;
Result.RowLen:= DrawBmpW;
{$ENDIF}
end;
w_XWindow:
@ -324,6 +327,7 @@ begin
//WriteLn(IntToStr(Self.XWindowImage^.width) + ', ' + IntToStr(Self.XWindowImage^.height));
Result.Ptr := PRGB32(Self.XWindowImage^.data);
Result.IncPtrWith := 0;
Result.RowLen := width;
Self.XImageFreed:=False;
XSetErrorHandler(Old_Handler);
@ -342,6 +346,7 @@ begin
Inc(TmpData, ys * width + xs);
Result.Ptr := TmpData;
Result.IncPtrWith:= Self.ArraySize.x - width;
Result.RowLen:= Self.ArraySize.x;
end;
end;