n3ss3s
11-17-2007, 09:04 AM
Well actually Im not sure can this be called FindObjOre anymore :p
But anyways, the reason I didn't post this in my thread in members section was
that I haven't given any 'big' functions to the Junior section (well this is 100 lines :) ) and if there are any a bit more advanced Junior Members that wanna learn about TPAs they can try and learn from this...
Also if someone feels like, is completely free to use this
as long as I get credit from these
Tested in Varrock East Mine
Tin rock
ColorToleranceSpeed(2)
Found the rock in 282ms, no world record but I didn't concentrate on the speed so much on this one.
Also the TPAFromBox takes 100ms, Wizzy should stuff something like that in his plugin.
Here you go -
program New;
{.include SRL/SRL.scar}
Var
Myx, Myy, MyOreColor, MyDirtColor: Integer;
Function CheckRockDirt(Var RefColor: Integer; Var rTPA: TPointArray; X, Y, Tol, HowMany, TheCTS, Dbg: Integer): Boolean;
Var
CTS, F, I, C, SmallTol: Integer;
TPA: TPointArray;
Begin
CTS := GetColorToleranceSpeed;
If Not CTS = TheCTS Then ColorToleranceSpeed(TheCTS);
FindColorsSpiralTolerance(X, Y, TPA, RefColor, X - 12, Y - 12, X + 12, Y + 12, Tol);
SmallTol := Tol;
For I := 0 To High(TPA) Do
Begin
C := GetColor(TPA[i].x, TPA[i].y);
If SimilarColors(C, RefColor, Tol) Then
Begin
F := F + 1;
If Round(Abs(C - RefColor)) < SmallTol Then
Begin
RefColor := C;
If Dbg = 1 Then Writeln('Found new RefColor!');
End;
SetArrayLength(rTPA, GetArrayLength(rTPA) + 1);
rTPA[High(rTPA)] := TPA[i];
End;
End;
If F >= HowMany Then
Result := True;
ColorToleranceSpeed(CTS);
End;
Procedure TPAFromBox(Var TPA: TPointArray; x1, y1, x2, y2: Integer);
Var
W, H, I, L, WD, HD: Integer;
Begin
WD := x2 - x1;
HD := y2 - y1;
L := (WD + 1) * (HD + 1);
SetArrayLength(TPA, L);
For W := x1 To x2 Do
For H := y1 To y2 Do
Begin
TPA[i] := IntToPoint(W, H);
I := I + 1;
End;
End;
Function OreColorsTPA(Var OreColor: Integer; Tol, TheCTS: Integer; TPA: TPointArray): Integer;
Var
I, CTS, C, X, Y: Integer;
colPoints: TPointArray;
Colors: TIntegerArray;
Begin
CTS := GetColorToleranceSpeed;
If Not CTS = TheCTS Then ColorToleranceSpeed(TheCTS);
MiddleTPAEx(TPA, X, Y);
TPAFromBox(colPoints, X - 12, Y - 12, X + 12, Y + 12);
Colors := GetColors(colPoints);
For I := 0 To High(colPoints) Do
If SimilarColors(Colors[i], OreColor, Tol) Then
Result := Result + 1;
ColorToleranceSpeed(CTS);
End;
Function FindObjNewOre(Var OreX, OreY: Integer; Var Color, DirtColor: Integer; Tol, DirtTol, Count, CTS: Integer): Boolean;
Var
Veins: Array of TPointArray;
rTPA, rPts: TPointArray;
TheCTS, C: Integer;
TP: TPoint;
Begin
TheCTS := GetColorToleranceSpeed;
If Not TheCTS = CTS Then ColorToleranceSpeed(CTS);
MA := GetSystemTime;
FindColorsSpiralTolerance(MSCX, MSCY, rTPA, Color, MSX1, MSY1, MSX2, MSY2, Tol);
Veins := SplitTPAEx(rTPA, 2, 2);
SetArrayLength(rTPA, GetArrayLength(Veins));
For C := 0 To High(rTPA) Do
Begin
rTPA[c] := MiddleTPA(Veins[c]);
If CheckRockDirt(DirtColor, rPts, rTPA[c].x, rTPA[c].y, DirtTol, 30, CTS, 2) Then
Begin
If OreColorsTPA(Color, Tol, Cts, rPts) >= Count Then
Begin
TP := MiddleTPA(rPTs);
MMouse(TP.x, TP.y, 2, 2);
If IsUpTextMulti('ine', 'Mine', 'ocks') Then
Begin
Result := True;
GetMousePos(OreX, OreY);
Break;
End;
End;
End;
End;
ColorToleranceSpeed(TheCTS);
End;
begin
SetupSRL;
MyOreColor := 7698047;
MyDirtColor := 1592925;
If FindObjNewOre(MyX, MyY, MyOreColor, MyDirtColor, 12, 12, 5, 2) Then
MMouse(MyX, MyY, 2, 2);
end.
EDIT: Worked for me without problem without using the uptext
(well it moved to a real rock on the first attempt so...)
but I put it there so people feel safer...
EDIT EDIT: I should use this in my VEM lol...
EDIT EDIT EDIT: I took out the re-coloring in OreColorsTPA, but anyone who can make a HelloWorld can put it back...
But anyways, the reason I didn't post this in my thread in members section was
that I haven't given any 'big' functions to the Junior section (well this is 100 lines :) ) and if there are any a bit more advanced Junior Members that wanna learn about TPAs they can try and learn from this...
Also if someone feels like, is completely free to use this
as long as I get credit from these
Tested in Varrock East Mine
Tin rock
ColorToleranceSpeed(2)
Found the rock in 282ms, no world record but I didn't concentrate on the speed so much on this one.
Also the TPAFromBox takes 100ms, Wizzy should stuff something like that in his plugin.
Here you go -
program New;
{.include SRL/SRL.scar}
Var
Myx, Myy, MyOreColor, MyDirtColor: Integer;
Function CheckRockDirt(Var RefColor: Integer; Var rTPA: TPointArray; X, Y, Tol, HowMany, TheCTS, Dbg: Integer): Boolean;
Var
CTS, F, I, C, SmallTol: Integer;
TPA: TPointArray;
Begin
CTS := GetColorToleranceSpeed;
If Not CTS = TheCTS Then ColorToleranceSpeed(TheCTS);
FindColorsSpiralTolerance(X, Y, TPA, RefColor, X - 12, Y - 12, X + 12, Y + 12, Tol);
SmallTol := Tol;
For I := 0 To High(TPA) Do
Begin
C := GetColor(TPA[i].x, TPA[i].y);
If SimilarColors(C, RefColor, Tol) Then
Begin
F := F + 1;
If Round(Abs(C - RefColor)) < SmallTol Then
Begin
RefColor := C;
If Dbg = 1 Then Writeln('Found new RefColor!');
End;
SetArrayLength(rTPA, GetArrayLength(rTPA) + 1);
rTPA[High(rTPA)] := TPA[i];
End;
End;
If F >= HowMany Then
Result := True;
ColorToleranceSpeed(CTS);
End;
Procedure TPAFromBox(Var TPA: TPointArray; x1, y1, x2, y2: Integer);
Var
W, H, I, L, WD, HD: Integer;
Begin
WD := x2 - x1;
HD := y2 - y1;
L := (WD + 1) * (HD + 1);
SetArrayLength(TPA, L);
For W := x1 To x2 Do
For H := y1 To y2 Do
Begin
TPA[i] := IntToPoint(W, H);
I := I + 1;
End;
End;
Function OreColorsTPA(Var OreColor: Integer; Tol, TheCTS: Integer; TPA: TPointArray): Integer;
Var
I, CTS, C, X, Y: Integer;
colPoints: TPointArray;
Colors: TIntegerArray;
Begin
CTS := GetColorToleranceSpeed;
If Not CTS = TheCTS Then ColorToleranceSpeed(TheCTS);
MiddleTPAEx(TPA, X, Y);
TPAFromBox(colPoints, X - 12, Y - 12, X + 12, Y + 12);
Colors := GetColors(colPoints);
For I := 0 To High(colPoints) Do
If SimilarColors(Colors[i], OreColor, Tol) Then
Result := Result + 1;
ColorToleranceSpeed(CTS);
End;
Function FindObjNewOre(Var OreX, OreY: Integer; Var Color, DirtColor: Integer; Tol, DirtTol, Count, CTS: Integer): Boolean;
Var
Veins: Array of TPointArray;
rTPA, rPts: TPointArray;
TheCTS, C: Integer;
TP: TPoint;
Begin
TheCTS := GetColorToleranceSpeed;
If Not TheCTS = CTS Then ColorToleranceSpeed(CTS);
MA := GetSystemTime;
FindColorsSpiralTolerance(MSCX, MSCY, rTPA, Color, MSX1, MSY1, MSX2, MSY2, Tol);
Veins := SplitTPAEx(rTPA, 2, 2);
SetArrayLength(rTPA, GetArrayLength(Veins));
For C := 0 To High(rTPA) Do
Begin
rTPA[c] := MiddleTPA(Veins[c]);
If CheckRockDirt(DirtColor, rPts, rTPA[c].x, rTPA[c].y, DirtTol, 30, CTS, 2) Then
Begin
If OreColorsTPA(Color, Tol, Cts, rPts) >= Count Then
Begin
TP := MiddleTPA(rPTs);
MMouse(TP.x, TP.y, 2, 2);
If IsUpTextMulti('ine', 'Mine', 'ocks') Then
Begin
Result := True;
GetMousePos(OreX, OreY);
Break;
End;
End;
End;
End;
ColorToleranceSpeed(TheCTS);
End;
begin
SetupSRL;
MyOreColor := 7698047;
MyDirtColor := 1592925;
If FindObjNewOre(MyX, MyY, MyOreColor, MyDirtColor, 12, 12, 5, 2) Then
MMouse(MyX, MyY, 2, 2);
end.
EDIT: Worked for me without problem without using the uptext
(well it moved to a real rock on the first attempt so...)
but I put it there so people feel safer...
EDIT EDIT: I should use this in my VEM lol...
EDIT EDIT EDIT: I took out the re-coloring in OreColorsTPA, but anyone who can make a HelloWorld can put it back...