List of things done to the script:
- Added const SW to use soul wars bank
- Changed break to 5 hours
- Added my own Make Item Menu detection
- Commented out the bank detecting amount (Have like 2M logs anyways and it wouldn't convert the letters right)
So if any changes are detrimental to your needs, then you can just change them around ;)
{==============================================================================]
[ [SRL] Forever Fletch & String by Narcle ]
[ ]
[ NAME : Forever Fletch & String ]
[ WRITER : Narcle ]
[ CATEGORY : Fletching ]
[ DESCRIPTION : Cuts Logs & strings bows ]
[ ]
[==============================================================================]
[ Instructions. ]
[==============================================================================]
[ ]
[ 1. Start next to any bank booth. ]
[ ]
[ 2. Bank Setup, 1st tab - top row: ]
[ [Logs] [String] [Unstrung bows] [4] [5] [6] [7] [8] [9] [10] ]
[ ]
[ 2.5 If cutting place knife in 1st inventory spot. ]
[ ]
[ 3. Setup players in 'DeclarePlayers' ]
[ ]
[ 4. Click play. ]
[==============================================================================}
{.include SRL/SRL/misc/smart.scar}
{.include srl/srl.scar}
{.include SRL/SRL/Misc/Reports.scar}
const
//Antiban
TakeBreaks = true;//Take breaks every 1-3 hours?
procedure DeclarePlayers;
begin
HowManyPlayers := 1;
NumberOfPlayers(HowManyPlayers);
CurrentPlayer := 0;
with Players[0] do
begin
Name := ''; //Character Name
Pass := ''; //Character Pass
Pin := ''; //Pin for bank
Active := True; //Use player in script?
strings[0] := 'Long';//Long, Short, Shafts, Stock, String
end;
end;
const
bank_Logs = 10;//Log spot in bank
bank_String = 8;//Strings spot in bank
bank_Unstrung = 9;//Unstrung bow spot in bank
SW = True;
type
TTPAItem = Record
OutLine, Width, Height, Color: Integer;
end;
TFS = record
Fletching, Stringing: boolean;
BankPoint: TPoint;
ToCut: string;
Log, BString, FBow, UBow: TTPAItem;
end;
var
LogTime, BreakTime: integer;
FS: array[0..99] of TFS;
ByeBye: Integer;
const
DebugOn = True;
C_OrangeMakeText = 2070783;
LOOP_WAIT = 100;
procedure Debug(s: string);
begin
if DebugOn then
Writeln(s)
else
Debugln(s);
end;
function MakeItemMenu(TimeOut: Integer): Boolean;
var
x, y, T: Integer;
begin
if not LoggedIn then Exit;
Result := FindColorSpiralTolerance(x, y, C_OrangeMakeText, MCX1, MCY1, MCX2, MCY2, 10);
if not Result then
begin
T := GetSystemTime;
repeat
if not LoggedIn then Exit;
Result := FindColorSpiralTolerance(x, y, C_OrangeMakeText, MCX1, MCY1, MCX2, MCY2, 10);
Wait(LOOP_WAIT);
if ((GetSystemTime - T) > TimeOut) then Exit;
until(Result)
end;
end;
function Loc(S: string): Boolean;
begin
Result := Lowercase(Players[CurrentPlayer].Loc) = LowerCase(S);
end;
procedure SetLoc(S: String);
begin
Players[CurrentPlayer].Loc := LowerCase(S);
end;
function MyGetAmount(ItemX, ItemY: Integer): Integer;
var
Col: TIntegerArray;
X, Y, i: Integer;
B: TBox;
TPA: TPointArray;
S: String;
begin
Result := 0;
If Not FindColor(X, Y, srl_outline_black, ItemX-30, ItemY-30, ItemX+30, ItemY+30)then
Exit;
Inc(Result);
Col := [65535, 16777215, 8453888];
For i := 0 to 2 do
If FindColors(TPA, Col[i], ItemX-22, ItemY-22, ItemX+22, ItemY+22)then
begin
B := GetTPABounds(TPA);
S := ExtractFromStr(GetTextAtExWrap(B.x1-1, B.y1-1, B.x2+1, B.y2+1, 0, 2, 4, Col[i], 0, 'StatChars'), numbers);
Result := StrToIntDef(GetNumbers(S), 1);
Case i of
1: Result := Result * 1000;
2: Result := Result * 1000000;
end;
Exit;
end;
end;
function TPAItem(cOutLine, cWidth, cHeight, cColor: Integer): TTPAItem;
begin
with Result do
begin
OutLine := cOutLine;
Width := cWidth;
Height := cHeight;
Color := cColor;
end;
end;
function FindTPAItem(Item: TTPAItem; B: TBox): Boolean;
var
TPA: TPointArray;
Bt: TBox;
x,y: integer;
begin
FindColorsTolerance(TPA, srl_outline_black, B.x1, B.y1, B.x2, B.y2, 0);
if Length(TPA) < 1 then
Exit;
Bt := GetTPABounds(TPA);
if (Length(TPA) = Item.OutLine) and (iAbs(Bt.x2-Bt.x1) = Item.Width) and (iAbs(Bt.y2-Bt.y1) = Item.Height) then
if Item.Color > -1 then
Result := FindColorTolerance(x, y, Item.Color, Bt.x1, Bt.y1, Bt.x2, Bt.y2, 9)
else
Result := True;
end;
Function UpdateItem(var Item: TTPAItem; InvN: integer): Boolean;
var
TPA: TPointArray;
T: TPoint;
B: TBox;
begin
if (Item.OutLine > 0) then
Exit;
Wait(300+random(200));
B := InvBox(InvN);
FindColorsTolerance(TPA, srl_outline_black, B.x1, B.y1, B.x2, B.y2, 0);
if Length(TPA) < 1 then
Exit;
B := GetTPABounds(TPA);
T := MiddleTPA(TPA);
Item := TPAItem(Length(TPA), iAbs(B.x2-B.x1), iAbs(B.y2-B.y1), GetColor(T.x, T.y));
Result := true;
Writeln('Item := TPAItem('+inttostr(Item.Outline) +', '+inttostr(Item.Width)+', '+inttostr(Item.Height)+', '+inttostr(Item.Color)+');');
end;
function iCount(Item: TTPAItem): Integer;
var
i: integer;
begin
for i := 1 to 28 do
if FindTPAItem(Item, InvBox(i)) then
Inc(Result);
end;
function FirstOccurance(Item: TTPAItem; OtherSlot: Integer; Norm: Boolean): Integer;
var
i: integer;
begin
GameTab(tab_Inv);
Result := -1;
if Norm then
begin
for i := OtherSlot to 28 do
if FindTPAItem(Item, InvBox(i)) then
begin
Result := i;
Exit;
end;
end else begin
i := OtherSlot;
repeat
if FindTPAItem(Item, InvBox(i)) then
begin
Result := i;
Exit;
end;
i := i - 1;
until (i <= 1)
end;
end;
function ItemSelected: integer;
var
i: integer;
Box: TBox;
TPA: TPointArray;
begin
for i := 1 to 28 do
begin
Box := InvBox(i);
FindColorsTolerance(TPA, 16777215, Box.x1, Box.y1, Box.x2, Box.y2, 0);
if Length(TPA) > 10 then
begin
Result := i;
Exit;
end;
end;
end;
Function SpiralMouseOutward(UpText, Option: String; Dist: Extended): TPoint;
var
angle, r: extended;
i, T_T: integer;
TPA: TPointArray;
B, P, M: TPoint;
begin
T_T := GetSystemTime + RandomRange(12500, 15500);
Result := Point(-1, -1);
B := Point(269, MSCY);
TPA := [Point(B.x-38, B.y), Point(B.x, B.y-32), Point(B.x+38, B.y), Point(B.x, B.y+39)];
for i := 0 to High(TPA) do
begin
MMouse(TPA[i].x-1, TPA[i].y-1, 2, 2);
if WaitUpText(UpText, 200) then
begin
GetMousePos(M.x, M.y);
Mouse(M.x, M.y, 0, 0, false);
if WaitOption(Option, 2000) then
begin
Result := Point(M.x, M.y);
Exit;
end;
end;
end;
angle := (5.283 + random(3));
repeat
angle := angle + 0.2618;
r := Dist * angle;
P := Point(Round(r * cos(angle)) + B.x, Round(r * sin(angle)) + B.y);
if PointInBox(P, IntToBox(MSX1, MSY1, MSX2, MSY2)) then
begin
MMouse(P.x, P.y, 2, 2);
if WaitUpText(UpText, 200) then
begin
GetMousePos(M.x, M.y);
Mouse(M.x, M.y, 0, 0, false);
if WaitOption(Option, 2000) then
begin
Result := Point(M.x, M.y);
Exit;
end;
end;
end else
Exit;
if(GetSystemTime > T_T)then
Exit;
until (Result.x > 0);
end;
procedure Report;
begin
if (GetTimeRunning < 60000) then
Exit;
SRLPlayerReport( ResultDebugBox, 0, False,
[True, False, False, False, False, False],
['Cut', 'Strung'],
[], [10, 11], [], []);
end;
Procedure ResetTimer(Time: string);
begin
Case LowerCase(Time) of
'logout': LogTime := GetSystemTime+RandomRange(19*60000, 31*60000);
'break': BreakTime := GetSystemTime+RandomRange(250*60000, 320*60000);
end;
end;
procedure SetupPlayer;
begin
SetAngle(true);
ResetTimer('logout');
end;
procedure LogoutSeq(reason:string);
var
T: integer;
begin
Writeln(reason);
CloseWindow;
Report;
if (reason = '') then
begin
Writeln('Nextplayer true.. WHAAAAT');
if (HowManyPlayers = 1) then
begin
FindNormalRandoms;
Logout;
T := GetSystemTime + RandomRange(5000, 90000);
Repeat
wait(1000);
until (GetSystemTime > T);
end;
NextPlayer(true);
end
else
begin
writeln(reason+', '+Players[CurrentPlayer].Name+' is now inactive.');
NextPlayer(false);
end;
TerminateScript;
SetupPlayer;
end;
procedure NoAction(Add: Boolean; Reason: String);
begin
if Add then
Writeln('Adding counter. ' + Reason)
else
Writeln('Reset counter');
if Add then
ByeBye := ByeBye + 1
else
ByeBye := 0;
if (ByeBye > 4) then
begin
Logout;
writeln('NoAction Terminate');
TerminateScript;
end;
end;
function TakeABreak: boolean;
var
H, M, S, BreakFor, T: integer;
begin
if ( GetSystemTime >= BreakTime ) then
begin
ExitToLobby;
result := true;
BreakFor := RandomRange((1/5) * 60000, 1 * 60000);
ConvertTime(BreakFor, H, M, S);
Report;
Writeln('Break for: '+inttostr(M)+ 'm:' +inttostr(S)+ 's');
ExitToLobby;
MarkTime(T);
Repeat
wait(1000);
until (BreakFor < TimeFromMark(T))
ResetTimer('Logout');
ResetTimer('Break');
LoginPlayer;
SetupPlayer;
end;
end;
Function Stringer: boolean;
var
StringSpot, UBowSpot, T: integer;
begin
With FS[CurrentPlayer] do
begin
if (iCount(UBow) = 0) or (iCount(BString) = 0) then
Exit;
Debug('Stringing...');
StringSpot := FirstOccurance(BString, 28, False);
if (Random(5) = 2) then
UBowSpot := FirstOccurance(UBow, 18, True)
else
UBowSpot := FirstOccurance(UBow, 1, True);
if (ItemSelected = 0) then
MouseItem(StringSpot, true);
repeat
if (ItemSelected = StringSpot) then
begin
MouseItem(UBowSpot, true);
Break;
end;
wait(50+random(100));
until (GetSystemtime > T);
if not MakeItemMenu(5000) then
begin
NoAction(True, 'No Make Menu; Stringing');
SetLoc('strunged');
Exit;
end;
NoAction(False, '');
Mouse(262, 423, RandomRange(-10, 10), RandomRange(-5, 5), True);
wait(random(300));
if (Random(100) < 90) then
SleepAndMoveMouse(500 + Random(3500));
T := GetSystemTime + 20000;
repeat
FindNormalRandoms;
if (Random(191) = 23) then
SleepAndMoveMouse(RandomRange(750, 4000));
Wait(200);
if ClickToContinue or (GetSystemTime > T) then
Exit;
until (iCount(UBow) = 0) and (InvCount < 15);
SetLoc('strunged');
Result := true;
UpdateItem(FBow, 2);
end;//With do End.
end;
Function Fletch: boolean;
var
LogSpot, KnifeSpot, T: integer;
begin
With FS[CurrentPlayer] do
begin
if (iCount(Log) = 0) then
Exit;
Debug('Fletching...');
KnifeSpot := 1;
if (Random(4) = 0) then
LogSpot := FirstOccurance(Log, 5, True)
else
LogSpot := FirstOccurance(Log, 1, True);
MouseItem(KnifeSpot, true);
T := GetSystemTime + 4000;
repeat
if (ItemSelected = KnifeSpot) then
begin
MouseItem(LogSpot, true);
Break;
end;
wait(50+random(100));
until (GetSystemtime > T);
if not MakeItemMenu(5000) then
begin
NoAction(True, 'No Make Menu; Fletching');
Exit;
end;
NoAction(False, '');
Mouse(262, 423, RandomRange(-10, 10), RandomRange(-5, 5), True);
wait(random(300));
if (Random(100) < 90) then
SleepAndMoveMouse(500 + Random(3500));
T := GetSystemTime + 90000;
repeat
Wait(200);
if (Random(175) = 63) then
SleepAndMoveMouse(RandomRange(750, 4000));
FindNormalRandoms;
if ClickToContinue then
Exit;
if (GetSystemTime > T) then
Exit;
until (iCount(Log) < 1);
SetLoc('fletched');
Result := true;
UpdateItem(UBow, 3);
end;//With do End.
end;
Function Bank: boolean;
var
TPA: TPointArray;
T, P, MidTPA: TPoint;
W, B, Timer, F, G, Z:integer;
begin
if SW then
begin
FindNormalRandoms;
Debug('Opening Soul Wars Bank...');
if not LoggedIn then LoginPlayer;
If (Not BankScreen) or (Not PinScreen) Then
begin
FindColorsTolerance(TPA, 13158609, 280, 150, 315, 195, 8);
if Length(TPA) > 1 then
begin
MidTPA := MiddleTPA(TPA);
MMouse(MidTPA.x, MidTPA.y, 2, 2);
if WaitUpText('hest', 500) then
begin
GetMousePos(F, G);
Mouse(F, G, 0, 0, False);
if WaitOption('hest', 2000) then
begin
FFlag(0);
Timer := GetSystemTime + 10000;
repeat
Wait(100+random(100));
If (GetsystemTime > Timer) Then
begin
SetLoc('at bank');
Exit;
end;
until (BankScreen or PinScreen);
end;
end;
end else begin
SetAngle(True);
//MakeCompass('W');
end;
end;
If (Not BankScreen) or (Not PinScreen) Then
begin
Z := GetSystemTime + 3500 + Random(1500);
repeat
if GetSystemTime > Z then Break;
until(BankScreen)
if Not BankScreen then
begin
FS[CurrentPlayer].BankPoint := SpiralMouseOutward('hest', 'hest', 3.5)
FFlag(0);
end;
end;
end else begin
FindNormalRandoms;
Debug('Opening Bank...');
T := FS[CurrentPlayer].BankPoint;
If (Not BankScreen) or (Not PinScreen) Then
if (T.x > 0) then
begin
MMouse(T.x-1, T.y-1, 3, 3);
if WaitUpText('ooth', 400) then
if WaitOption('uickl', 2000)then
begin
FFlag(0);
Timer := GetSystemTime + 10000;
repeat
Wait(100+random(100));
FindNormalRandoms;
If (GetsystemTime > Timer) Then
begin
SetLoc('at bank');
Exit;
end;
until (BankScreen or PinScreen);
end;
end;
If (Not BankScreen) or (Not PinScreen) Then
begin
FS[CurrentPlayer].BankPoint := SpiralMouseOutward('ooth', 'uickl', 3.5)
FFlag(0);
end;
end;
Writeln('After');
Timer := GetSystemTime + 10000;
repeat
Wait(100+random(100));
FindNormalRandoms;
If (GetsystemTime > Timer) Then
begin
SetLoc('at bank');
Exit;
end;
until (BankScreen or PinScreen);
if PinScreen then
begin
Debug('Entering Pin...');
B := 0;
repeat
InPin(Players[CurrentPlayer].Pin);
B := B + 1;
until (BankScreen) or ( B > 5 )
end;
if BankScreen then
With FS[CurrentPlayer] do
begin
repeat
Wait(100+random(100));
Until (CountColor(65535, MBX1, MBY1, MBX2, MBY2) > 50) or not LoggedIn;
IncEx(Players[CurrentPlayer].Integers[10], iCount(UBow));
IncEx(Players[CurrentPlayer].Integers[11], iCount(FBow));
repeat
if not LoggedIn then
Exit;
Debug('Banking...');
if Fletching then
Deposit(2, 28, true);
if Stringing then
Deposit(1, 28, true);
FixBank;
if Fletching then
begin
if (InvCount < 1) then
begin
Writeln('invcount < 1');
NoAction(True, 'InvC Fletching');
Exit;
end;
{ T := BankIndexToMSPoint(bank_Logs);
if (MyGetAmount(T.x+8, T.y+8) < 29) then
begin
writeln('i dunno lol');
NoAction(True);
Exit;
end; }
Debug('Withdrawing...');
P := BankIndexToBankPoint(bank_Logs);
Withdraw(P.x, P.y, 0);
Timer := GetSystemTime + 60000;
Repeat
Wait(50);
until (GetSystemTime > Timer) or (InvCount = 28);
UpdateItem(Log, 3);
end;
if Stringing then
begin
{T := BankIndexToMSPoint(bank_String);
if (MyGetAmount(T.x+8, T.y+8) < (15)) then
begin
NoAction(True);
Exit;
end;
T := BankIndexToMSPoint(bank_Unstrung);
if (MyGetAmount(T.x+8, T.y+8) < (15)) then
begin
NoAction(True);
Exit;
end; }
Debug('Withdrawing...');
P := BankIndexToBankPoint(bank_String);
Withdraw(P.x, P.y, 14);
Timer := GetSystemTime + 60000;
Repeat
Wait(50);
until (GetSystemTime > Timer) or (InvCount = 14);
if (GetSystemTime > Timer) then
Exit;
UpdateItem(BString, 3);
P := BankIndexToBankPoint(bank_Unstrung);
Withdraw(P.x, P.y, 14);
Timer := GetSystemTime + 60000;
Repeat
Wait(50);
until (GetSystemTime > Timer) or (InvCount = 28);
UpdateItem(UBow, 16);
end;
if (GetSystemTime > Timer) then
Exit;
Inc(W);
if (W > 3) then
begin
LogoutSeq('Banking failed');
Exit;
end;
until (InvCount = 28);
end;
Debug('Done Banking...');
CloseWindow;
Inc(Players[CurrentPlayer].Banked);
SetLoc('Banked');
result := true;
Report;
end;
Procedure ScriptSetup;
var
i: integer;
begin
Smart_Server := 54;
Smart_Members:= true;
Smart_Signed := true;
Smart_SuperDetail := false;
SetupSRL;
DeclarePlayers;
//ScriptID := '1152';
for i := 0 to HowManyPlayers-1 do
begin
Case Lowercase(Players[i].strings[0]) of
'long', 'long bow', 'longbow':
begin
FS[i].Fletching := true;
FS[i].ToCut := 'Long Bow';
end;
'short', 'short bow', 'shortbow':
begin
FS[i].Fletching := true;
FS[i].ToCut := 'Short Bow';
end;
'shafts', 'arrow shafts', 'arrowshafts':
begin
FS[i].Fletching := true;
FS[i].ToCut := 'rrow Shafts';
end;
'stock', 'crossbow stock', 'crossbowstock':
begin
FS[i].Fletching := true;
FS[i].ToCut := 'Crossbow Stock';
end;
'string', 'stringing':
FS[i].Stringing := true;
else
begin
Writeln('Fletching string is wrong, fix it!');
TerminateScript;
end;
end;
Players[i].Loc := 'at bank';
end;
end;
begin
ScriptSetup;
ByeBye := 0;
While not RSReady do
Wait(200);
Loginplayer;
SetupPlayer;
ResetTimer('break');
repeat
if Loc('at bank') or Loc('fletched') or Loc('strunged') then
Bank;
if Loc('banked') then
begin
if FS[CurrentPlayer].Fletching then
Fletch;
if FS[CurrentPlayer].Stringing then
Stringer;
end;
if (HowManyPlayers > 1) then
if (GetSystemTime > LogTime) then
LogoutSeq('');
if TakeBreaks then
TakeABreak;
until false;
end.
