Log in

View Full Version : Sugestion Needed



Tonekray
11-26-2006, 02:09 AM
Well I'm making a chicken killer in Lumbrige. It was originaly to be a bone picker and burrier but the I just started adding stuff. Everything works fine exept the feather picker. I need a better way of picking the feathers up because it just mistakes it for the wall. Any ideas?

Script:
program BoneMaster;

{.include SRL/SRL.scar}
{.include SRL/SRL/Skill/Fighting.scar}

Var
X2, Y2 : Integer; // Cordnate Varriables

Bones : Integer; // Script Varriables

ChickCol, FeatherColor : Integer; // Color Varriables

I, G, L : Integer; // Temp Varriable

Time : Integer; // Time Mark Varriable

Boned, Feathed : Boolean; // Script Booleans

Const
BonesWanted = 200; // How many bones do you want?
Tol = 5; // If AutoColor use 10, if you choose color use 5.
Debug = True; // Set True if you want debug information.
Collect = 3; // 0 Is Nothing 1 Is Bone 2 Is Feathers 3 Is All

// Dont touch unless AutoColor does not work.

BoneColor1 = 12434886;
ChickenCol1 = 15658736;
ChickenCol2 = 9934755;
ChickenCol3 = 923760;
FeatherCol1 = 12171971;
FeatherCol2 = 11119285;
FeatherCol3 = 9984;

Procedure DeclarePlayers;
Begin
HowManyPlayers := 1;
NumberOfPlayers(HowManyPlayers);
Players[0].Name := 'Username';
Players[0].Pass := 'Password';
Players[0].Nick := 'Nickname';
Players[0].Loc := 'Chickens';
Players[0].Active := True;

LoginPlayer;

Wait ( 500 )
End;

Procedure TKDebug ( What : String; Okay : Boolean );
Begin
If Okay Then
Writeln ( What )
Else
Status ( What )
End;

{================================================= =========================
=========================== Fighting Procedures ===========================
================================================== ========================}

Function LocateChicken ( x, y, ChickenCol1z, ChickenCol2z, ChickenCol3z : Integer ) : Boolean;
Begin

If FindColorTolerance ( x2, y2, ChickenCol1z, MSX1, MSY1, MSX2, MSY2, 10 ) Then
TKDebug ( 'Located Chicken 1/3', Debug )
Wait ( 1000 )
ChickCol := ChickenCol1z;
Result := True;
Exit;

If Not FindColorTolerance ( x2, y2, ChickenCol1z, MSX1, MSY1, MSX2, MSY2, 10 ) Then
TKDebug ( 'Cant Find Chicken At 1/3', Debug )
Wait ( 1000 )

If FindColorTolerance ( x2, y2, ChickenCol2z, MSX1, MSY1, MSX2, MSY2, 10 ) Then
TKDebug ( 'Located Chicken 2/3', Debug )
Wait ( 1000 )
ChickCol := ChickenCol2z;
Result := True;
Exit;

If Not FindColorTolerance ( x2, y2, ChickenCol2z, MSX1, MSY1, MSX2, MSY2, 10 ) Then
TKDebug ( 'Cant Find Chicken At 2/3', Debug )
Wait ( 1000 )

If FindColorTolerance ( x2, y2, ChickenCol3z, MSX1, MSY1, MSX2, MSY2, 10 ) Then
TKDebug ( 'Located Chicken 3/3', Debug )
Wait ( 1000 )
ChickCol := ChickenCol3z;
Result := True;
Exit;

If Not FindColorTolerance ( x2, y2, ChickenCol3z, MSX1, MSY1, MSX2, MSY2, 10 ) Then
TKDebug ( 'Cant Find Chicken At 3/3', Debug )
Writeln ( 'Cant find chicken colors, please set them' )
Repeat
FindNormalRandoms;
Wait ( 1000 )
ClearDebug;
Writeln ( 'Press 12 to exit, otherwise will log out.' )
Until Not LoggedIn Or IsFKeyDown ( 12 )
TerminateScript;
End;


Function FightChicken ( x, y, TrueChickColor, Tol : Integer ) : Boolean;
Var
NTol : Integer;
Chick : Boolean;
Begin
If FindObj ( x, y, 'Attack', TrueChickColor, Tol ) Then
Begin
TKDebug ( 'Located Chicken at: ' + Inttostr ( x ) + ', ' + Inttostr ( y ), Debug )
Case Random ( 2 ) Of
0: Begin Mouse ( x, y, 2, 2, True ) End;
1: Begin Mouse ( x, y, 2, 2, False ) ChooseOption ( x, y, 'Attack' ) End;
End;
FindNormalRandoms;
Result := True;
End;

If Not Result Then
Begin
NTol := Tol;
Repeat
If FindObj ( x, y, 'Chicken', TrueChickColor, NTol ) Then
Begin
TKDebug ( 'Located Chicken at: ' + Inttostr ( x ) + ', ' + Inttostr ( y ) + ' With a tol of: ' + Inttostr ( NTol ), Debug )
Case Random ( 2 ) Of
0: Begin Mouse ( x, y, 2, 2, True ) End;
1: Begin Mouse ( x, y, 2, 2, False ) ChooseOption ( x, y, 'Attack' ) End;
End;
FindNormalRandoms;
Result := True;
End;
NTol := NTol + 1;
Until Result Or ( NTol = 20 )
End;

If Result Then
Begin
Chick := True;
Feathed := False;
Boned := False;
Flag;
Repeat
FindNormalRandoms;
Wait ( 2000 )
MMouse ( Random ( MSX2 ), Random ( MSY2 ), 10, 10 )
TKDebug ( 'In Fight, Using Anti-Mouse', Debug )
Until Not InFight
TKDebug ( 'Out Of Fight, Ending Anti-Mouse', Debug )
End;
End;

{================================================= =========================
=========================== Feather Procedures ============================
================================================== ========================}

Procedure ChangeAngle; Forward;

Function LocateFeather ( x, y, FeatherColor1z, FeatherColor2z, FeatherColor3z : Integer ) : Boolean;
Begin
If FindColorTolerance ( x, y, FeatherColor1z, MSX1, MSY1, MSX2, MSY2, 10 ) Then
Begin
TKDebug ( 'Located Feather 1/3', Debug )
Wait ( 1000 )
FeatherColor := FeatherColor1z;
Result := True;
Exit;
End Else;
Begin
TKDebug ( 'Cant Find Feather At 1/3', Debug )
Wait ( 1000 )
End;

If FindColorTolerance ( x, y, FeatherColor1z, MSX1, MSY1, MSX2, MSY2, 10 ) Then
Begin
TKDebug ( 'Located Feather 2/3', Debug )
Wait ( 1000 )
FeatherColor := FeatherColor2z;
Result := True;
Exit;
End Else;
Begin
TKDebug ( 'Cant Find Feather At 2/3', Debug )
Wait ( 1000 )
End;

If FindColorTolerance ( x, y, FeatherColor1z, MSX1, MSY1, MSX2, MSY2, 10 ) Then
Begin
TKDebug ( 'Located Feather 3/3', Debug )
Wait ( 1000 )
FeatherColor := FeatherColor3z;
Result := True;
Exit;
End Else;
Begin
TKDebug ( 'Cant Find Feather At 3/3', Debug )
Writeln ( 'Cant find feather color, please set them' )
Wait ( 1000 )
Repeat
FindNormalRandoms;
Wait ( 1000 )
ClearDebug;
Writeln ( 'Press 12 to exit, otherwise will log out.' )
Until Not LoggedIn Or IsFKeyDown ( 12 )
TerminateScript;
End;
End;

Function PickFeather ( x, y, TrueFeatherColor, Tol : Integer ) : Boolean;
Begin
MarkTime ( Time )
Repeat
If FindObj ( x, y, TrueFeatherColor, MSX1, MSY1, MSX2, MSY2, Tol + 10 ) Then
Begin
MMouse ( x, y, 1, 1 )
TKDebug ( 'Located Feathers, Picking Up', Debug )
If IsUpText ( 'Feather' ) Then
Begin
GetMousePos ( x, y )
ClickMouse ( x, y, False )
If ChooseOption ( x, y, 'Take' ) Then
Begin
Wait ( 1000 )
FindNormalRandoms;
Result := True;
Feathed := True;
End;
L := L + 1;
End;
ChangeAngle;
End;
Until ( L = 10 ) Or ( TimeFromMark ( Time ) > 6000 ) Or ( Feathed )
End;

{================================================= =========================
============================= Bone Procedures =============================
================================================== ========================}

{Function CheckItem ( ItemNumber : Integer; ItemName : String ) : Boolean;
Var
ItemX, ItemY : Integer;
Begin

ItemX := ItemCoords ( I );
ItemY := ItemCoords ( I );

If FindColorTolerance ( x, y, BoneColor, ItemX - 5, ItemY - 5, ItemX + 5, ItemY + 5, 10 ) Then
Begin
Status ( 'Bone is at: ' + I )
Result := True;
Wait ( 100 )
End;
End;}

{Function NotBones : Boolean;
Begin
If IsUpText ( 'Chicken' ) Or
IsUpText ( 'Attack' ) Or
IsUpText ( 'Raw' ) Or
IsUpText ( 'Egg' ) Or
IsUpText ( 'Walk' ) Then
Begin
Wait ( 1000 + Random ( 1000 ) )
Result := True;
End;
End;}

Procedure TurnRight;
Begin
KeyDown ( VK_RIGHT )
Wait ( 100 + Random ( 100 ) )
KeyUp ( VK_RIGHT );
End;

Procedure TurnLeft;
Begin
KeyDown ( VK_LEFT )
Wait ( 100 + Random ( 100 ) )
KeyUp ( VK_LEFT );
End;

Procedure ChangeAngle;
Begin

Case Random ( 2 ) Of
0 : TurnRight
1 : TurnLeft
End;

Wait ( 1000 )
End;

Procedure PickBone;
Begin
MarkTime ( Time )
Repeat
If FindColorTolerance ( x2, y2, BoneColor1, MSX1, MSY1, MSX2, MSY2, Tol ) Then
Begin
MMouse ( x2, y2, 2, 2 )
TKDebug ( 'Locating Dropped Bones Or Stray Bones', Debug )
If IsUpText ( 'Bones' ) Then
Begin
Mouse ( x2, y2, 2, 2, False )
Wait ( 300 )
If ChooseOption ( x, y, 'Take' ) Then
Begin
MarkTime ( Time )
Flag;
Repeat
Wait ( 100 )
FindNormalRandoms;
Until ExistsItem ( I ) Or ( TimeFromMark ( Time ) > 3000 )
TKDebug ( 'Got Bones', Debug )
Wait ( 100 )
Boned := True;
I := I + 1;
End;
G := G + 1;
End;
ChangeAngle;
End;
Until ( G = 10 ) Or ( TimeFromMark ( Time ) > 6000 ) Or Boned
End;

Function DropBones : Boolean;
Var
J : Integer;
Begin
J := 1;
If InvFull Then
Begin
TKDebug ( 'Dropping Bones', Debug )
Repeat
MMouseItem ( J )
If IsUpText ( 'Bury' ) Then
Begin
GetMousePos ( x2, y2 )
ClickMouse ( x2, y2, false)
Wait ( 300 + Random ( 300 ) )
If ChooseOption ( x, y, 'Bury' ) Then
Begin
Repeat
Wait ( 100 )
FindNormalRandoms;
Until Not ExistsItem ( J )
Result := True;
End;
End;
J := J + 1;
Until ( J = 28 ) And Not ExistsItem ( 28 )
End;
End;

{================================================= =========================
================================ Main Loop ================================
================================================== ========================}

begin
SetupSRL;
ActivateClient;
DeclarePlayers;
I := 1;
G := 1;
L := 1;
HighestAngle;
LocateChicken ( x2, y2, ChickenCol1, ChickenCol2, ChickenCol3 )
LocateFeather ( x2, y2, FeatherCol1, FeatherCol2, FeatherCol3 )
SetRun ( True )
Repeat
Repeat
FightChicken ( x2, y2, ChickCol, 10 )
If ( Collect = 1 ) Or ( Collect = 3 ) Then
Begin
PickBone;
End;
If ( Collect = 2 ) Or ( Collect = 3 ) Then
Begin
PickFeather ( x2, y2, FeatherColor, Tol );
End;
Until InvFull
DropBones;
Until ( Bones = BonesWanted )
end.

tarajunky
11-26-2006, 02:39 AM
use the greenish color of the feather stem. works great.

m0u53m4t
11-26-2006, 11:37 AM
Just use a findobj spiral. Thats what I use for my bone picker and burier and it can work for about 5 hours on end!

Tonekray
11-26-2006, 02:03 PM
tara I dont see any green stem on the feather 0-0

m0u53 whats the difference between findobj and findobjspiral?

EDIT** Oddly enough I cant find the Findobjspiral...

WT-Fakawi
11-26-2006, 02:28 PM
Hit F1 from SCAR. Helpfile!

Tonekray
11-26-2006, 03:45 PM
Ah okay, I thought SpiralFindObj was in SRL :D

EDIT** Ah nvm the SpiralFindObj doesnt work. It just sits there for the maximum time I asked for and does nothing...

m0u53m4t
11-26-2006, 06:03 PM
Try this:



function FindObjB(var cx, cy: Integer; Text: String; color, tolerance: Integer): Boolean;
var
Timees,x, y, a, c, i, x1, y1, x2, y2: Integer;
begin
if (FindMSColorTol(x, y, color, tolerance)) then
begin
x1 := 245;
y1 := 165;
x2 := 277;
y2 := 185;
repeat
if (not (Loggedin)) then
break;
a := a + 1;
if (a = 1) then
c := c + 1;
if (a = 3) then
c := c + 1;
for i := 1 to c do
begin
if (a = 1) then
begin
x1 := x1 + 30;
x2 := x2 + 30;
End;
if (a = 2) then
begin
y1 := y1 - 20;
y2 := y2 - 20;
End;
if (a = 3) then
begin
x1 := x1 - 30;
x2 := x2 - 30;
End;
if (a = 4) then
begin
y1 := y1 + 20;
y2 := y2 + 20;
End;
if (x1 = 485) and (x2 = 517) then
x2 := x2 - 2;
if (y1 = 325) and (y2 = 345) then
y2 := y2 - 7;
if (x2 > 515) then
Break;
if (FindColorTolerance(x, y, color, x1, y1, x2, y2, tolerance)) then
begin
Timees:=Timees+1
MMouse(x, y, 0, 0)
cx := x; cy := y;
if(Timees>10)
then
begin
timees:=0
End;
wait(100+random(30))
if (IsUpText(Text)) then
begin
Result := True;
Break;
End;
End;
End;
if (a = 4) then
a := 0;
until (x2 > 515) or (Result = True);
End;
timees:=0
End;

procedure findchickens;
begin
repeat
SendArrowSilentWait(1, 100 + random(500));
findnormalrandoms
until FindObjB(x,y,'Feath',15000807,15)


That will find feathers and leave your mouse on them.

Tonekray
11-26-2006, 07:06 PM
Okay Ill try that when I get my regular comp back. Thanks.