moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2025-02-25 16:01:48 -05:00
Code Issues Releases Wiki Activity

CTS: Cleanups.

Browse Source
This commit is contained in:
Merlijn Wajer 2011-06-13 20:21:23 +02:00
parent 14474a84ab
commit 7a412d1670
1 changed files with 74 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

153
Units/MMLCore/finder.pas
View File

@ -30,14 +30,12 @@ interface
{$define CheckAllBackground}//Undefine this to only check the first white point against the background (in masks). {$define CheckAllBackground}//Undefine this to only check the first white point against the background (in masks).
uses uses
colour_conv, Classes, SysUtils,bitmaps,MufasaBase,DTM, MufasaTypes; // Types colour_conv, Classes, SysUtils, bitmaps, DTM, MufasaTypes; // Types
{ TMFinder Class } { TMFinder Class }
{ {
Should be 100% OS independant, Should be 100% OS independant, as all OS dependant code is in the IO Manager.
as all OS dependant code is in the IO Manager
Let's try not to use any OS-specific defines here? ;) Let's try not to use any OS-specific defines here? ;)
} }
@ -101,19 +99,16 @@ type
implementation implementation
uses uses
// colour_conv,// For RGBToColor, etc. Client, // For the Client casting.
Client, // For the Client Casts. math, // min/max
math, //min/max tpa, //TPABounds
mmath, dtmutil;
tpa, //TPABounds
dtmutil
;
procedure TMFinder.LoadSpiralPath(startX, startY, x1, y1, x2, y2: Integer); procedure TMFinder.LoadSpiralPath(startX, startY, x1, y1, x2, y2: Integer);
var var
i,c,Ring : integer; i,c,Ring : integer;
CurrBox : TBox; CurrBox : TBox;
begin; begin
i := 0; i := 0;
Ring := 1; Ring := 1;
c := 0; c := 0;
@ -126,7 +121,7 @@ begin;
ClientTPA[c] := Point(Startx, StartY); ClientTPA[c] := Point(Startx, StartY);
Inc(c); Inc(c);
end; end;
Repeat repeat
if (CurrBox.x2 >= x1) and (CurrBox.x1 <= x2) and (Currbox.y1 >= y1) and (Currbox.y1 <= y2) then if (CurrBox.x2 >= x1) and (CurrBox.x1 <= x2) and (Currbox.y1 >= y1) and (Currbox.y1 <= y2) then
for i := CurrBox.x1 + 1 to CurrBox.x2 do for i := CurrBox.x1 + 1 to CurrBox.x2 do
if (I >= x1) and ( I <= x2) then if (I >= x1) and ( I <= x2) then
@ -164,16 +159,16 @@ begin;
and (currbox.y2 > y2); and (currbox.y2 > y2);
end; end;
function CalculateRowPtrs(ReturnData : TRetData; RowCount : integer) : TPRGB32Array;overload; function CalculateRowPtrs(ReturnData: TRetData; RowCount: integer) : TPRGB32Array; overload;
var var
I : integer; I : integer;
begin; begin;
setlength(result,RowCount); SetLength(result,RowCount);
for i := 0 to RowCount - 1 do for i := 0 to RowCount - 1 do
result[i] := ReturnData.Ptr + ReturnData.RowLen * i; result[i] := ReturnData.Ptr + ReturnData.RowLen * i;
end; end;
function CalculateRowPtrs(Bitmap : TMufasaBitmap) : TPRGB32Array;overload; function CalculateRowPtrs(Bitmap : TMufasaBitmap) : TPRGB32Array; overload;
begin begin
Result := Bitmap.RowPtrs; Result := Bitmap.RowPtrs;
end; end;
@ -1039,72 +1034,74 @@ end;
function TMFinder.FindColorsTolerance(out Points: TPointArray; Color, xs, ys, function TMFinder.FindColorsTolerance(out Points: TPointArray; Color, xs, ys,
xe, ye, Tol: Integer): Boolean; xe, ye, Tol: Integer): Boolean;
var var
PtrData: TRetData; PtrData: TRetData;
Ptr: PRGB32; Ptr: PRGB32;
PtrInc,C: Integer; PtrInc,C: Integer;
dX, dY, clR, clG, clB: Integer; dX, dY, clR, clG, clB: Integer;
H1, S1, L1, H2, S2, L2, hueXTol, satXTol: Extended;
procedure cts0; procedure cts0;
var xx, yy: integer; var xx, yy: integer;
begin begin
for yy := ys to ye do for yy := ys to ye do
begin begin
for xx := xs to xe do for xx := xs to xe do
begin begin
if ((abs(clB-Ptr^.B) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clR-Ptr^.R) <= Tol)) then if ((abs(clB-Ptr^.B) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clR-Ptr^.R) <= Tol)) then
begin;
ClientTPA[c].x := xx;
ClientTPA[c].y := yy;
inc(c);
end;
inc(Ptr);
end;
Inc(Ptr, PtrInc);
end;
end;
procedure cts1;
var xx, yy: integer;
begin
for yy := ys to ye do
begin
for xx := xs to xe do
begin
if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then
begin;
ClientTPA[c].x := xx;
ClientTPA[c].y := yy;
inc(c);
end;
inc(ptr);
end;
Inc(Ptr, PtrInc);
end;
end;
procedure cts2;
var xx, yy: integer;
begin
HueXTol := hueMod * Tol;
SatXTol := satMod * Tol;
for yy := ys to ye do
begin
for xx := xs to xe do
begin
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2);
if ((abs(H1 - H2) <= HueXTol) and (abs(S1 - S2) <= SatXTol) and (abs(L1 - L2) <= Tol)) then
begin; begin;
ClientTPA[c].x := xx; ClientTPA[c].x := xx;
ClientTPA[c].y := yy; ClientTPA[c].y := yy;
Inc(c); inc(c);
end; end;
Inc(Ptr) inc(Ptr);
end; end;
Inc(Ptr, PtrInc); Inc(Ptr, PtrInc);
end; end;
end; end;
procedure cts1;
var xx, yy: integer;
begin
for yy := ys to ye do
begin
for xx := xs to xe do
begin
if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then
begin;
ClientTPA[c].x := xx;
ClientTPA[c].y := yy;
inc(c);
end;
inc(ptr);
end;
Inc(Ptr, PtrInc);
end;
end;
procedure cts2;
var xx, yy: integer;
H1, S1, L1, H2, S2, L2, hueXTol, satXTol: Extended;
begin
ColorToHSL(color,H1,S1,L1);
HueXTol := hueMod * Tol;
SatXTol := satMod * Tol;
for yy := ys to ye do
begin
for xx := xs to xe do
begin
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2);
if ((abs(H1 - H2) <= HueXTol) and (abs(S1 - S2) <= SatXTol) and (abs(L1 - L2) <= Tol)) then
begin;
ClientTPA[c].x := xx;
ClientTPA[c].y := yy;
Inc(c);
end;
Inc(Ptr)
end;
Inc(Ptr, PtrInc);
end;
end;
begin begin
Result := false; Result := false;
DefaultOperations(xs,ys,xe,ye); DefaultOperations(xs,ys,xe,ye);
@ -1113,8 +1110,6 @@ begin
dY := ye - ys; dY := ye - ys;
//next, convert the color to r,g,b //next, convert the color to r,g,b
ColorToRGB(Color, clR, clG, clB); ColorToRGB(Color, clR, clG, clB);
if CTS = 2 then
ColorToHSL(color,H1,S1,L1);
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1); PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);