moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-05 08:55:15 -05:00
Code Issues Releases Wiki Activity

FindDeformedBitmapToleranceIn has been improved! Is zeh win now. (beats scar, imo).

Browse Source 
Oh and we can now type more than 80 chars a line (in synedit).


git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@147 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond 2009-10-22 14:25:20 +00:00
parent a8c22c4ffa
commit 3b603917a0
9 changed files with 1209 additions and 1066 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

480
Projects/SAMufasaGUI/project1.lpi
View File

File diff suppressed because it is too large Load Diff

18
Projects/SAMufasaGUI/testunit.lfm
View File

@ -5,7 +5,7 @@ object Form1: TForm1
Width = 723
ActiveControl = SynEdit1
Caption = 'Mufasa v2'
ClientHeight = 528
ClientHeight = 533
ClientWidth = 723
Menu = MainMenu1
OnClose = FormClose
@ -15,7 +15,7 @@ object Form1: TForm1
LCLVersion = '0.9.29'
object SynEdit1: TSynEdit
Left = 8
Height = 328
Height = 333
Top = 32
Width = 704
Align = alCustom
@ -27,8 +27,7 @@ object Form1: TForm1
ParentColor = False
ParentFont = False
TabOrder = 0
BookMarkOptions.OnChange = nil
Gutter.Width = 61
Gutter.Width = 57
Gutter.MouseActions = <
item
Shift = []
@ -602,8 +601,6 @@ object Form1: TForm1
'begin'
'end.'
)
MaxLeftChar = 80
ScrollBars = ssAutoBoth
BracketHighlightStyle = sbhsBoth
OnChange = OnSyneditChange
OnProcessCommand = SynEditProcessCommand
@ -612,7 +609,7 @@ object Form1: TForm1
Width = 23
end
object TSynGutterLineNumber
Width = 21
Width = 17
MouseActions = <>
MarkupInfo.Background = clBtnFace
MarkupInfo.Foreground = clNone
@ -723,6 +720,7 @@ object Form1: TForm1
Caption = 'ToolBar1'
Images = Mufasa_Image_List
TabOrder = 2
OnClick = ToolBar1Click
object TB_Run: TToolButton
Left = 1
Top = 2
@ -825,7 +823,7 @@ object Form1: TForm1
object Memo1: TMemo
Left = 13
Height = 139
Top = 365
Top = 370
Width = 694
Anchors = [akLeft, akRight, akBottom]
ScrollBars = ssAutoBoth
@ -833,8 +831,8 @@ object Form1: TForm1
end
object StatusBar: TStatusBar
Left = 0
Height = 21
Top = 507
Height = 23
Top = 510
Width = 723
Panels = <
item

1448
Projects/SAMufasaGUI/testunit.lrs
View File

File diff suppressed because it is too large Load Diff

8
Projects/SAMufasaGUI/testunit.pas
View File

@ -97,6 +97,7 @@ type
procedure NoTray(Sender: TObject);
procedure SynEditProcessCommand(Sender: TObject;
var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer);
procedure ToolBar1Click(Sender: TObject);
procedure ToTray(Sender: TObject);
procedure Undo(Sender: TObject);
private
@ -291,6 +292,11 @@ begin
end;
end;
procedure TForm1.ToolBar1Click(Sender: TObject);
begin
end;
procedure TForm1.ToTray(Sender: TObject);
begin
Form1.Hide;
@ -355,6 +361,8 @@ begin
ScriptChanged := false;
SynEdit1.Lines.SaveToFile(ScriptFile);
StartText:= SynEdit1.Lines.Text;
SynEdit1.MarkTextAsSaved;
Self.Caption:= Format(WindowTitle,[ScriptName]);
end
else
result := SaveCurrentScriptAs;

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

@ -247,3 +247,9 @@ begin;
result := MFinder.FindBitmapMaskTolerance(MBitmaps.bmp[mask].CreateTMask,x,y,xs,ys,xe,ye,tolerance,contourtolerance);
end;
function FindDeformedBitmapToleranceIn(bitmap: integer; var x,
y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer;
AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean;
begin;
result := CurrThread.Client.MFinder.FindDeformedBitmapToleranceIn(CurrThread.Client.MBitmaps.bmp[Bitmap],x,y,xs,ys,xe,ye,tolerance,range,AllowPartialAccuracy,accuracy);
end;

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

@ -133,3 +133,4 @@ Sender.AddFunction(@PosterizeBitmap,'function PosterizeBitmap(Bitmap : 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;');
Sender.AddFunction(@FindDeformedBitmapToleranceIn,'function FindDeformedBitmapToleranceIn(bitmap: integer; var x,y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean;');

1
Units/MMLCore/bitmaps.pas
View File

@ -55,6 +55,7 @@ type
function FastGetPixels(TPA : TPointArray) : TIntegerArray;
Procedure SetTransparentColor(Col : TColor);
Function GetTransparentColor : TColor;
property TransparentColorSet : boolean read TransparentSet;
procedure FastDrawClear(Color : TColor);
procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);
procedure FastReplaceColor(OldColor, NewColor: TColor);

193
Units/MMLCore/finder.pas
View File

@ -82,7 +82,8 @@ type
implementation
uses
Client, // For the Client Casts.
colour_conv // For RGBToColor, etc.
colour_conv, // For RGBToColor, etc.
math //min/max
;
type
TPRGB32Array = array of PRGB32;
@ -158,6 +159,68 @@ begin;
for i := 0 to Bitmap.Height - 1 do
result[i] := Bitmap.FData + Bitmap.Width * i;
end;
//SkipCoords[y][x] = False/True; True means its "transparent" and therefore not needed to be checked.
procedure CalculateBitmapSkipCoords(Bitmap : TMufasaBitmap; out SkipCoords : T2DBoolArray);
var
x,y : integer;
R,G,B : byte;
Ptr : PRGB32;
begin;
r := 0;
g := 0;
b := 0;
if Bitmap.TransparentColorSet then
ColorToRGB(Bitmap.GetTransparentColor,r,g,b);
Ptr := Bitmap.FData;
SetLength(SkipCoords,Bitmap.Height,Bitmap.Width);
for y := 0 to Bitmap.Height - 1 do
for x := 0 to Bitmap.Width - 1 do
begin;
if (Ptr^.r = r) and (Ptr^.g = g) and (Ptr^.b = b) then
SkipCoords[y][x] := True
else
SkipCoords[y][x] := false;
inc(ptr);
end;
end;
//Points left holds the amount of points that are "left" to be checked (Including the point itself.. So for example Pointsleft[0][0] would hold the total amount of pixels that are to be checked.
procedure CalculateBitmapSkipCoordsEx(Bitmap : TMufasaBitmap; out SkipCoords : T2DBoolArray;out TotalPoints : integer; out PointsLeft : T2DIntArray);
var
x,y : integer;
R,G,B : byte;
Ptr : PRGB32;
TotalC : integer;
begin;
r := 0;
g := 0;
b := 0;
TotalC := 0;
if Bitmap.TransparentColorSet then
ColorToRGB(Bitmap.GetTransparentColor,r,g,b);
Ptr := Bitmap.FData;
SetLength(SkipCoords,Bitmap.Height,Bitmap.Width);
SetLength(PointsLeft,Bitmap.Height,Bitmap.Width);
for y := 0 to Bitmap.Height - 1 do
for x := 0 to Bitmap.Width - 1 do
begin;
if (Ptr^.r = r) and (Ptr^.g = g) and (Ptr^.b = b) then
SkipCoords[y][x] := True
else
begin;
SkipCoords[y][x] := false;
inc(TotalC);
end;
inc(ptr);
end;
TotalPoints:= TotalC;
for y := 0 to Bitmap.Height - 1 do
for x := 0 to Bitmap.Width - 1 do
begin;
PointsLeft[y][x] := TotalC;
if not SkipCoords[y][x] then
Dec(TotalC);
end;
end;
constructor TMFinder.Create(aClient: TObject);
@ -776,6 +839,7 @@ var
xBmp,yBmp : integer;
tmpY : integer;
dX, dY, xx, yy: Integer;
SkipCoords : T2DBoolArray;
label NotFoundBmp;
//Don't know if the compiler has any speed-troubles with goto jumping in nested for loops.
@ -798,6 +862,8 @@ begin
//Heck our bitmap cannot be outside the search area
dX := dX - bmpW;
dY := dY - bmpH;
//Get the "skip coords".
CalculateBitmapSkipCoords(Bitmap,SkipCoords);
for yy := 0 to dY do
for xx := 0 to dX do
begin;
@ -805,10 +871,11 @@ begin
begin;
tmpY := yBmp + yy;
for xBmp := 0 to BmpW do
if (BmpRowData[yBmp][xBmp].R <> MainRowdata[tmpY][xBmp + xx].R) or
(BmpRowData[yBmp][xBmp].G <> MainRowdata[tmpY][xBmp + xx].G) or
(BmpRowData[yBmp][xBmp].B <> MainRowdata[tmpY][xBmp + xx].B) then
goto NotFoundBmp;
if not SkipCoords[yBmp][xBmp] then
if (BmpRowData[yBmp][xBmp].R <> MainRowdata[tmpY][xBmp + xx].R) or
(BmpRowData[yBmp][xBmp].G <> MainRowdata[tmpY][xBmp + xx].G) or
(BmpRowData[yBmp][xBmp].B <> MainRowdata[tmpY][xBmp + xx].B) then
goto NotFoundBmp;
end;
//We did find the Bmp, otherwise we would be at the part below
@ -834,6 +901,7 @@ var
dX, dY, xx, yy: Integer;
CCTS : integer;
H,S,L,HMod,SMod : extended;
SkipCoords : T2DBoolArray;
label NotFoundBmp;
//Don't know if the compiler has any speed-troubles with goto jumping in nested for loops.
@ -860,6 +928,8 @@ begin
CCTS := Self.CTS;
if CCTS > 1 then
CCTS := 1;
//Get the "skip coords".
CalculateBitmapSkipCoords(Bitmap,SkipCoords);
for yy := 0 to dY do
for xx := 0 to dX do
begin;
@ -867,11 +937,12 @@ begin
begin;
tmpY := yBmp + yy;
for xBmp := 0 to BmpW do
if not ColorSame(CCTS,tolerance,
BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B,
MainRowdata[tmpY][xBmp + xx].R,MainRowdata[tmpY][xBmp + xx].G,MainRowdata[tmpY][xBmp + xx].B,
H,S,L,HMod,SMod) then
goto NotFoundBmp;
if not SkipCoords[yBmp][xBmp] then
if not ColorSame(CCTS,tolerance,
BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B,
MainRowdata[tmpY][xBmp + xx].R,MainRowdata[tmpY][xBmp + xx].G,MainRowdata[tmpY][xBmp + xx].B,
H,S,L,HMod,SMod) then
goto NotFoundBmp;
end;
//We did find the Bmp, otherwise we would be at the part below
@ -895,6 +966,7 @@ var
xBmp,yBmp : integer;
tmpY : integer;
dX, dY, i,HiSpiral: Integer;
SkipCoords : T2DBoolArray;
label NotFoundBmp;
//Don't know if the compiler has any speed-troubles with goto jumping in nested for loops.
@ -920,16 +992,19 @@ begin
//Load the spiral into memory
LoadSpiralPath(x-xs,y-ys,0,0,dX,dY);
HiSpiral := (dx+1) * (dy+1) - 1;
//Get the "skip coords".
CalculateBitmapSkipCoords(Bitmap,SkipCoords);
for i := 0 to HiSpiral do
begin;
for yBmp:= 0 to BmpH do
begin;
tmpY := yBmp + ClientTPA[i].y;
for xBmp := 0 to BmpW do
if (BmpRowData[yBmp][xBmp].R <> MainRowdata[tmpY][xBmp + ClientTPA[i].x].R) or
(BmpRowData[yBmp][xBmp].G <> MainRowdata[tmpY][xBmp + ClientTPA[i].x].G) or
(BmpRowData[yBmp][xBmp].B <> MainRowdata[tmpY][xBmp + ClientTPA[i].x].B) then
goto NotFoundBmp;
if not SkipCoords[yBmp][xBmp] then
if (BmpRowData[yBmp][xBmp].R <> MainRowdata[tmpY][xBmp + ClientTPA[i].x].R) or
(BmpRowData[yBmp][xBmp].G <> MainRowdata[tmpY][xBmp + ClientTPA[i].x].G) or
(BmpRowData[yBmp][xBmp].B <> MainRowdata[tmpY][xBmp + ClientTPA[i].x].B) then
goto NotFoundBmp;
end;
//We did find the Bmp, otherwise we would be at the part below
@ -955,6 +1030,7 @@ var
dX, dY, i,HiSpiral: Integer;
CCTS : integer;
H,S,L,HMod,SMod : extended;
SkipCoords : T2DBoolArray;
label NotFoundBmp;
//Don't know if the compiler has any speed-troubles with goto jumping in nested for loops.
@ -984,18 +1060,21 @@ begin
CCTS := Self.CTS;
if CCTS > 1 then
CCTS := 1;
//Get the "skip coords".
CalculateBitmapSkipCoords(Bitmap,SkipCoords);
for i := 0 to HiSpiral do
begin;
for yBmp:= 0 to BmpH do
begin;
tmpY := yBmp + ClientTPA[i].y;
for xBmp := 0 to BmpW do
if not ColorSame(CCTS,tolerance,
BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B,
MainRowdata[tmpY][xBmp + ClientTPA[i].x].R,MainRowdata[tmpY][xBmp + ClientTPA[i].x].G,
MainRowdata[tmpY][xBmp + ClientTPA[i].x].B,
H,S,L,HMod,SMod) then
goto NotFoundBmp;
if not SkipCoords[yBmp][xBmp] then
if not ColorSame(CCTS,tolerance,
BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B,
MainRowdata[tmpY][xBmp + ClientTPA[i].x].R,MainRowdata[tmpY][xBmp + ClientTPA[i].x].G,
MainRowdata[tmpY][xBmp + ClientTPA[i].x].B,
H,S,L,HMod,SMod) then
goto NotFoundBmp;
end;
//We did find the Bmp, otherwise we would be at the part below
@ -1021,6 +1100,7 @@ var
FoundC : integer;
CCTS : integer;
H,S,L,HMod,SMod : extended;
SkipCoords : T2DBoolArray;
label NotFoundBmp;
//Don't know if the compiler has any speed-troubles with goto jumping in nested for loops.
@ -1051,18 +1131,21 @@ begin
if CCTS > 1 then
CCTS := 1;
FoundC := 0;
//Get the "skip coords".
CalculateBitmapSkipCoords(Bitmap,SkipCoords);
for i := 0 to HiSpiral do
begin;
for yBmp:= 0 to BmpH do
begin;
tmpY := yBmp + ClientTPA[i].y;
for xBmp := 0 to BmpW do
if not ColorSame(CCTS,tolerance,
BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B,
MainRowdata[tmpY][xBmp + ClientTPA[i].x].R,MainRowdata[tmpY][xBmp + ClientTPA[i].x].G,
MainRowdata[tmpY][xBmp + ClientTPA[i].x].B,
H,S,L,HMod,SMod) then
goto NotFoundBmp;
if not SkipCoords[yBmp][xBmp] then
if not ColorSame(CCTS,tolerance,
BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B,
MainRowdata[tmpY][xBmp + ClientTPA[i].x].R,MainRowdata[tmpY][xBmp + ClientTPA[i].x].G,
MainRowdata[tmpY][xBmp + ClientTPA[i].x].B,
H,S,L,HMod,SMod) then
goto NotFoundBmp;
end;
//We did find the Bmp, otherwise we would be at the part below
@ -1089,16 +1172,17 @@ var
PtrData : TRetData;
BmpW,BmpH : integer;
xBmp,yBmp : integer;
tmpY,tmpX : integer;
dX, dY, xx, yy: Integer;
SearchdX,SearchdY : integer;
CCTS : integer;
GoodCount : integer;//Save the amount of pixels who have found a correspondening pixel
BestCount : integer;//The best amount of pixels till now..
BestPT : TPoint; //The point where it found the most pixels.
RangeX,RangeY : Integer;
H,S,L,HMod,SMod : extended;
label FoundBMPPoint;
yStart,yEnd,xStart,xEnd : integer;
TotalC : integer;
SkipCoords : T2DBoolArray;
PointsLeft : T2DIntArray;
label FoundBMPPoint, Madness;
//Don't know if the compiler has any speed-troubles with goto jumping in nested for loops.
begin
@ -1121,14 +1205,12 @@ begin
//Heck our bitmap cannot be outside the search area
dX := dX - bmpW;
dY := dY - bmpH;
//We wont want HSL comparison with BMPs, right? Not for now atleast.
CCTS := Self.CTS;
if CCTS > 1 then
CCTS := 1;
//Reset the accuracy :-)
Accuracy := 0;
BestCount := -1;
BestPT := Point(-1,-1);
//Get the "skip coords". and PointsLeft (so we can calc whether we should stop searching or not ;-).
CalculateBitmapSkipCoordsEx(Bitmap,SkipCoords,TotalC,PointsLeft);
for yy := 0 to dY do
for xx := 0 to dX do
@ -1136,26 +1218,25 @@ begin
GoodCount := 0;
for yBmp:= 0 to BmpH do
begin;
//Calculate points of the BMP left against Goodcount (if it cannot possibly get more points skip this x,y?
if bestCount > (goodcount + (Bmph - yBmp) * (bmpW)) then
Break;
for xBmp := 0 to BmpW do
begin;
for RangeY := (yy-Range) to (yy + Range) do
//We do not have to check this point, win win win <--- triple win <-- JACKPOT!
if SkipCoords[yBmp][xBmp] then
Continue;
//Calculate points of the BMP left against Goodcount (if it cannot possibly get more points skip this x,y?
if bestCount > (GoodCount + PointsLeft[yBmp][xBmp]) then
goto Madness;
//The point on the bitmap + the the coordinate we are on at the "screen" minus the range.
yStart := max(yBmp + yy-Range,0);
yEnd := Min(yBmp + yy+range,SearchdY);
for RangeY := yStart to yEnd do
begin;
tmpY := yBmp + RangeY;
if (tmpY < 0) or (tmpY > SearchdY ) then
continue;
for RangeX := (xx-Range) to (xx + Range) do
xStart := max(xx-Range + xBmp,0);
xEnd := Min(xx+range + xBmp,SearchdX);
for RangeX := xStart to xEnd do
begin;
tmpX := xBmp + RangeX;
if (tmpX < 0) or (tmpX > SearchdX) then
Continue;
if ColorSame(CCTS,tolerance,
BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B,
MainRowdata[tmpY][tmpX].R,MainRowdata[tmpY][tmpX].G,MainRowdata[tmpY][tmpX].B,
H,S,L,HMod,SMod) then
if Sqrt(sqr(BmpRowData[yBmp][xBmp].R - MainRowdata[RangeY][RangeX].R) + sqr(BmpRowData[yBmp][xBmp].G - MainRowdata[RangeY][RangeX].G)
+sqr(BmpRowData[yBmp][xBmp].B - MainRowdata[RangeY][RangeX].B)) <= tolerance then
goto FoundBMPPoint;
end;
end;
@ -1166,16 +1247,26 @@ begin
inc(GoodCount);
end;
end;
//If we jumped to Madness it means we did not have enuf points left to beat tha fu-king score.
Madness:
if GoodCount > BestCount then //This x,y has the best Acc so far!
begin;
BestCount := GoodCount;
BestPT := Point(xx+xs,yy+ys);
if GoodCount = TotalC then
begin;
TClient(Client).MWindow.FreeReturnData;
x := BestPT.x;
y := BestPT.y;
accuracy:= 1;
Exit(true);
end;
end;
end;
TClient(Client).MWindow.FreeReturnData;
if BestCount = 0 then
Exit;
accuracy := BestCount / ((BmpW + 1) * (BmpH+1));
accuracy := BestCount / TotalC;
if (accuracy = 1) or AllowPartialAccuracy then
begin
x := BestPT.x;

4
Units/MMLCore/mufasatypes.pas
View File

@ -51,7 +51,9 @@ type
TPointArray = array of TPoint;
TVariantArray = Array of Variant;
TIntegerArray = Array of Integer;
T2DIntArray = array of TIntegerArray;
TBoolArray = array of boolean;
T2DBoolArray = Array of TBoolArray;
TExtendedArray = Array of Extended;
T2DExtendedArray = Array of Array of Extended;
{ Mask Types }