Simba Code:
{*******************************************************************************
program GnomeAgilityBasic;
by; nosaj421
Description: Does Basic Gnome Agility Course for agility XP
Instructions: 1. Position character at the slippery log (course start sign)
2. Run.
Check out the thread at SRL Forums Agility Section for other instructions and bugs
*******************************************************************************}
program GnomeAgilityBasic;
{$DEFINE SRL5}
{$DEFINE SMART}
{$I SRL/SRL/misc/SMART.simba}
{$I SRL/SRL.simba}
//{$DEFINE DEBUG} //uncomment if you need debug info
//{$DEFINE DEBUG_DRAW} //uncomment if you need debug info
{$IFDEF DEBUG_DRAW}
{$I SRL/SRL/misc/debug.simba}
{$I SRL/SRL/misc/paintsmart.simba}
{$ENDIF}
const
SmartWorld = 1;
Members = False;
SignedClient = True;
HighDetail = False;
var startXP: integer;
procedure DeclarePlayers;
Begin
HowManyPlayers := 1; //change accordingly
NumberOfPlayers(HowManyPlayers);
CurrentPlayer := 0;
With Players[0] Do
Begin
Name := ''; //Player username.
Pass := ''; //Player password.
Nick := ''; //Player nickname - 3-4 letters of Player username.
Active := True;
End;
{
With Players[1] Do
Begin
Name := ''; //Player username.
Pass := ''; //Player password.
Nick := ''; //Player nickname - 3-4 letters of Player username.
Active := True;
End;
}
End;
procedure DoLogin;
var t: integer;
begin
MarkTime(t);
while not LoggedIn do
begin
LoginPlayer;
if (TimeFromMark(t) > 180000) then
begin
srl_warn('DoLogin', 'Still not logged in after 180s - Will terminate',
warn_AllVersions);
TerminateScript;
end;
wait(5000);
end;
end;
procedure antiRandoms;
begin
if FindNormalRandoms then
if not LoggedIn then //Logged out because of random, nextplayer
begin
Players[CurrentPlayer].Active := False;
NextPlayer(Players[CurrentPlayer].Active);
Exit;
end;
end;
procedure ProgressReport(var startXP: integer);
var gain: integer;
begin
gain := GetXPBarTotal- startXP;
writeln('Time running: ' + TimeRunning);
writeln('Exp Gained: ' + IntToStr(gain));
writeln('Est XP/H: ' + floatToStr(3600000 * 1.0 / GetTimeRunning * gain));
end;
procedure WaitTillStationary;
begin
if not LoggedIn then Exit;
repeat
wait(200+random(50));
until not IsMoving;
end;
{*******************************************************************************
function ObjFindCTS2(color, tol, atpaw, atpah: integer; area: TIntegerArray;
uptext: TStringArray; max: integer; var click: boolean): boolean;
by; nosaj421
Description: CTS2 Object Finder Wrapper using ATPA
Returns true if color is found
Finds color and tolerance and split tpa using TPAtoATPAEx into w,h
Allows area specification to search subarea of the screen
Uses UpText to determine clicking (click is always left)
Use max to filter how many TPAs to try the mouse on
click determines whether redclick has been successfully done
Default sort order of TPA is from MSCX MSCY
*******************************************************************************}
function ObjFindCTS2(color, tol, atpaw, atpah: integer; area: TIntegerArray; uptext: TStringArray; max: integer; var click: boolean): boolean;
var tcts, i: integer;
tpa: TPointArray;
tpa2: TPointArray;
atpa: T2DPointArray;
begin
Result:=False;
tcts:=GetToleranceSpeed;
SetColorToleranceSpeed(2);
SetColorSpeed2Modifiers(0.2, 0.2);
if not (Length(area) = 4) then
FindColorsTolerance(tpa, color, MSX1, MSY1, MSX2, MSY2, tol)
else
FindColorsTolerance(tpa, color, area[0], area[1], area[2], area[3], tol);
SetColorToleranceSpeed(tcts);
if length(tpa) < 1 then Exit;
atpa:=TPAtoATPAEx(tpa, atpaw, atpah);
if length(atpa) < 1 then Exit;
Result:=True;
setLength(tpa2, length(atpa));
for i:=0 to high(atpa) do
tpa2[i]:=MiddleTPA(atpa[i]);
SortTPAFrom(tpa2, Point(MSCX, MSCY));
{$IFDEF DEBUG_DRAW}
debugATPABounds(atpa);
{$ENDIF}
click:=false;
for i:=0 to high(tpa2) do
begin
if (i>max) then break;
Mouse(tpa2[i].x, tpa2[i].y, 2, 2, mouse_move);
if WaitUpTextMulti(uptext, 1000) then
begin
ClickMouse2(mouse_left);
click:=DidRedClick;
if click then
begin
writeln('Did red click!');
break;
end;
wait(100);
end;
end;
end;
{*******************************************************************************
function MouseUpText(x, y, rx, ry:integer; uptext: TStringArray): Boolean;
by; nosaj421
Description: Mouse and Uptext wrapper
Returns true if uptext is matched at mouse position and redclick is
successful
*******************************************************************************}
function MouseUpText(x, y, rx, ry:integer; uptext: TStringArray): Boolean;
begin
Result:=False;
Mouse(x, y, rx, ry, mouse_move);
if WaitUpTextMulti(uptext, 1000) then
begin
ClickMouse2(mouse_left);
Result:= DidRedClick;
if Result then
writeln('Did red click!');
end;
end;
{*******************************************************************************
function IsStrInBlackChat(msg: string): boolean;
by; nosaj421
Description: Regex match string in last black check message, used to check
whether we passed the obstacles succesfully
*******************************************************************************}
function IsStrInBlackChat(msg: string): boolean;
var s:string;
begin
s:= getBlackChatMessage;
Result:= ExecRegExpr(msg, s);
{$IFDEF DEBUG}
writeln('debug: '+s);
writeln('debug: trying to match: '+msg);
if Result then writeln('debug: Regex found! Success!');
{$ENDIF}
end;
{*******************************************************************************
function CheckRopeEvent: boolean;
by; nosaj421
Description: Separate wrapper to check whether we passed the rope
*******************************************************************************}
function CheckRopeEvent: boolean;
var t: integer;
begin
Result:=False;
MarkTime(t);
repeat
if IsStrInBlackChat('cross') then
begin
Result:=True;
break;
end;
if IsStrInBlackChat('reach') then break; //failure
until (TimeFromMark(t) > 5000);
end;
{*******************************************************************************
function CheckPipeEvent: Boolean;
by; nosaj421
Description: Similar wrapper to check whether we passed the pipe
*******************************************************************************}
function CheckPipeEvent: Boolean;
var t: integer;
begin
Result:=False;
MarkTime(t);
repeat
if IsStrInBlackChat('into') then
begin
Result:=True;
break;
end;
if IsStrInBlackChat('used') then break; //failure
until (TimeFromMark(t) > 5000);
end;
{*******************************************************************************
procedure DoCourse(action: string);
by; nosaj421
Description: Main loop that handles the course, all colors are here
Use debug_draw if you think the colors are wrong and update them
The flow has basic failsafes but I am aware of bugs :)
Use at own risk!
*******************************************************************************}
procedure DoCourse(action: string);
//var action: string;
var b, click: Boolean;
v: TVariantArray;
begin
writeln('current action is: '+ action);
while LoggedIn do
begin
case action of
'log': begin
b:= ObjFindCTS2(2108729, 5, 20, 20, [],['alk'], 0, click);
wait(2000);
b:= ObjFindCTS2(2700350, 5, 20, 20, [],['ross'], 0, click);
v:=['log'];
if b and not click then
b:= WaitFuncEx('IsStrInBlackChat', v, 100, 1500);
if b then
begin
action:='net1';
wait(4000);
waitTillStationary;
{$IFDEF DEBUG}
writeln(getBlackChatMessage);
{$ENDIF}
end;
end;
'net1': begin //safe so far
b:= ObjFindCTS2(3096404, 5, 20, 20, [MSCX-10, MSCY, MSCX+10, MSY2],['limb'], 0, click);
v:=['netting'];
if b and not click then
b:=WaitFuncEx('IsStrInBlackChat', v, 100, 1500);
if b then
begin
action:='branch1';
wait(5000);
{$IFDEF DEBUG}
writeln(getBlackChatMessage);
{$ENDIF}
end;
end;
'branch1': begin //safe so far
click:=false;
b:=ObjFindCTS2(3556689, 5, 20, 20, [MSCX-20, MSCY+10, MSCX+20, MSCY+60], ['imb'], 0, click);
v:=['above'];
if b and not click then
b:=WaitFuncEx('IsStrInBlackChat', v, 100, 2000);
if b then
begin
action:='rope';
wait(2000);
{$IFDEF DEBUG}
writeln(getBlackChatMessage);
{$ENDIF}
end;
end;
'rope': begin //need failsafe!
click:=false;
b:= ObjFindCTS2(5799582, 5, 10, 10, [MSCX, MSCY-10, MSX2, MSY2], ['on '], 2, click);
if b then
b:=CheckRopeEvent;
if b then
begin
action:='branch2';
wait(4200);
waitTillStationary;
{$IFDEF DEBUG}
writeln(getBlackChatMessage);
{$ENDIF}
end;
end;
'branch2': begin //very safe //still wrong
b:= MouseUpText(MSCX + 160, MSCY + 30, 10, 5, ['own']);
v:=['land'];
if not b then
b:= WaitFuncEx('IsStrInBlackChat', v, 100, 1500);
if b then
begin
action:='net2';
wait(5000);
{$IFDEF DEBUG}
writeln(getBlackChatMessage);
{$ENDIF}
end;
end;
'net2': begin //safe so far
Mouse(MSCX, MSCY-100, 5, 5, mouse_left);
wait(1800);
waitTillStationary;
b:= ObjFindCTS2(3096404, 5, 20, 20, [],['imb'], 0, click);
v:=['netting'];
if b and not click then
b:= WaitFuncEx('IsStrInBlackChat', v, 100, 1500);
if b then
begin
action:='pipe';
wait(4000);
{$IFDEF DEBUG}
writeln(getBlackChatMessage);
{$ENDIF}
end;
end;
'pipe': //need failsafe!
begin
click:=false;
b:= ObjFindCTS2(1645857, 8, 20, 20, [MSX1, MSY1, MSX2, MSCY-50], ['ough'], 0, click);
if b then
b:=CheckPipeEvent; //have to ask this no matter what
if b then
begin
action:='ret';
wait(4700);
{$IFDEF DEBUG}
writeln(getBlackChatMessage);
{$ENDIF}
end;
end;
'ret': begin
if RadialWalkTolerance(1716802, 270, 265, 65, 0, 0, 15) then
begin
action:='log';
waitTillStationary;
end;
progressReport(startXP);
end;
end;
wait(50);
AntiRandoms;
writeln('current action is: '+ action);
end;
end;
begin
Smart_Server := SmartWorld;
Smart_Members := Members;
Smart_Signed := SignedClient;
Smart_SuperDetail := HighDetail;
ClearDebug;
SetupSRL();
DeclarePlayers;
repeat
DoLogin;
while LoggedIn do
begin
SetAngle(SRL_ANGLE_HIGH);
ToggleXPBar(true);
startXP:=GetXPBarTotal;
DoCourse('log');
end;
until AllPlayersInactive;
end.