I wanted a ess miner, but this one didn't work… So I looked at it, thought the color of the symbol was wrong, made a new one, and it worked! So here the script again with the new color and for the others, the inAbyss is commented out.
program New;
{$i srl/srl/misc/smart.simba}
{$i srl/srl.simba}
{$ifdef smart}
{$i srl/srl/misc/paintsmart.simba}
{$endif}
Const
NumberOfUsers = 1;
StartPlayer = 0;
Loads = 5;
VersionNumber = '3.01';
FastAubury = True;
SRL_ID = ''; // Stats ID.
SRL_PASS = ''; // Stats Pass.
//SmartPrefix = 'world10';
{Type
EssLoc = Record
Name: String;
Info: Array Of Array Of Integer;
MMClicks, MSEss: TPointArray;
L, ReportIDVar: Integer;
End;
EssLocArray = Array Of EssLoc; }
Var
// EssInfo: EssLocArray;
AubTPA: TPointArray;
NewAutoColorWorked, NoEssFound: Boolean;
EssenceMined, Abyss: Integer;
MiddleDTM1, MiddleDTM2, DTMAuburyMap, DTMAuburyDoor : integer;
//BlackOffset : integer;
//{$DEFINE DEBUG}
Procedure DeclarePlayers;
Begin
NumberOfPlayers( NumberOfUsers );
CurrentPlayer := StartPlayer;
Players[0].Name :='';
Players[0].Pass :='';
Players[0].Nick :='gpk';
Players[0].Active := True;
Players[0].Loc := 'Bank';
Players[0].Booleans[0] := False; // Is The Pick Equipped?
// Is The Pick Equipped?
Writeln( IntToStr ( HowManyPlayers ) + ' Players' );
End;
Procedure FNRWait(ms: Integer);
Var
T: Integer;
Begin
T := GetSystemTime;
While GetSystemTime - T < ms Do
Begin
Wait(200);
FindNormalRandoms;
End;
End;
procedure MFlag;
var
t : integer;
begin
FFlag(0);
t := GetSystemTime;
while (GetSystemTime-t) < 7500 do
if (PixelShift(IntToBox(mmx1, mmy1, mmx2, mmy2), 200)) < 1000 then //1000 should do
break;
end;
Procedure DebugMM(TPA: TPointArray);
{
Var
I, L: Integer;
C: TCanvas; }
Begin
{DisplayDebugImgWindow(0, 0);
DisplayDebugImgWindow(MMX2-MMX1, MMY2-MMY1);
C := GetDebugCanvas;
CopyCanvas(GetClientCanvas, C, MMX1, MMY1, MMX2, MMY2, 0, 0, MMX2 - MMX1, MMY2 - MMy1);
L := High(tpa);
For I := 0 To L Do
C.Pixels[tpa[i].x - MMX1, tpa[i].y - MMY1] := 255;
DisplayDebugImgWindow(MMX2-MMX1, MMY2-MMY1); }
End;
function BlackOffset : integer; //Inspired by GetMinimapDots
var //18msecs, pretty slow...
TPA : TPointArray;
i : integer;
begin
result := -1;
FindColorsTolerance(TPA, 3699532, mmx1, mmy1, mmx2, mmy2, 20); //should do?
for i := 0 to high(TPA) do
begin
if (GetColor(TPA[I].X, TPA[I].Y) - GetColor(TPA[I].X-1, TPA[I].Y) = (3699532-1196650)) then
begin //a1 //a2 //a1-a2 = dif
Result := 0-((3699532-329220)-GetColor(TPA[I].X, TPA[I].Y));//magic //c1-c2 = dif
//writeln('Black offset: '+ToStr(result)); //c2 = c1-dif
exit;
end;
end;
end;
Function FindMagicSymbol(Var P: TPoint): Boolean; //Could do something nice with the black offset here...
Var
I, J, cts: Integer;
Points, P2: TPointArray;
aTPA: T2DPointArray;
MagicSymbolColors, C: TIntegerArray;
H, S, L: Extended;
Begin
cts := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetColorSpeed2Modifiers(0.20, 2.0);
Result := False;
MagicSymbolColors := [2595570, 2925567];
SetLength(Points, 0);
For I := 0 To High(MagicSymbolColors) Do
Begin
SetLength(P2, 0);
SetLength(C, 0);
//writeln('U wanted me?');
FindColorsTolerance(P2, MagicSymbolColors[I], MMX1, MMY1, MMX2, MMY2, 10);
C := GetColors(P2);
For J := 0 To High(C) Do
Begin
ColorToHSL(C[J], H, S, L);
//If ((H > 8.5) And (H < 9.5)) Or ((H > 5.5) And (H < 7.5)) Then
If (((H > 5.5) And (H < 10.0)) Or (H < 1.0)) And (S > 85.0) Then
Begin
SetLength(Points, Length(Points) + 1);
Points[High(Points)] := P2[J];
End;
End;
//Points := CombineTPA(Points, P2);
End;
{$IFDEF DEBUG} debugMM(Points); {$ENDIF}
ColorToleranceSpeed(cts);
aTPA := SplitTPA(Points, 5);
SortATPASize(aTPA, True);
If Length(aTPA) = 0 Then
Exit;
Result := Length(aTPA[0]) > 2;
P := MiddleTPA(aTPA[0]);
If Not Result Then
WriteLn('No Aubury Shop');
End;
function FindAuburyStore(var P : TPoint) : boolean;
var
AuburyMapDDTM : TSDTM;
DTMAuburyMap : integer;
aFound : extended;
P2 : TPoint;
begin
if (BlackOffset = -1) then
begin
result := FindMagicSymbol(P);
exit;
end;
{ Stop here.
Look at this DDTM, it works quite smart imho ^-^.
This uses the old colour relation technique discovered by yours truly in 2007.
The technique is most commonly used for autocoloring stuff, but there are a
few other uses like this one. The black colour is nowadays also 'modified'
(not static), so I use it as an offset. From every colour, the main 'black'
is substracted (the 329220) so it's made for black = 0. Because nowadays in RS
the black is never true black, we add the 'rs black' to it (AtMine sets it).
This way, we can create a DDTM with 100% accurate colors. No false positives.
Note, it has a bit of area tolerance to accomodate for RS ugly rotation.
For some reason, the last point (which is just terrain) didn't work too well
so that one uses regular 15 tol. It's just an anchor point though, the real
uniqueness is point 0 (the tiny bit of black at the the left).
Points 1 and 2 are the two trees south of VEB, behind the fence. }
AuburyMapDDTM.MainPoint.x := 608;
AuburyMapDDTM.MainPoint.y := 107;
AuburyMapDDTM.MainPoint.Color := 13371337; //who cares
AuburyMapDDTM.MainPoint.Tolerance := 500; //tol is high enough
SetLength(AuburyMapDDTM.SubPoints, 4);
with AuburyMapDDTM.SubPoints[0] do
begin
x := 668;
y := 109;
Color := BlackOffset;
areasize := 2;
end;
with AuburyMapDDTM.SubPoints[1] do
begin
x := 606;
y := 48;
Color := 3699532-329220+BlackOffset; //green
Tolerance := 0;
AreaSize := 2;
end;
with AuburyMapDDTM.SubPoints[2] do
begin
x := 615;
y := 49;
Color := 1196650-329220+BlackOffset; //brown
AreaSize := 2;
end;
with AuburyMapDDTM.SubPoints[3] do //This is part of the terrain
begin //probably calculated different or whatever
x := 631;
y := 49;
Color := 2511437-329220+BlackOffset;
AreaSize := 2;
Tolerance := 15;
end;
//After typing this all of this by hand, WHERE THE F@#! IS THE DDTM EDITOR!!!
DTMAuburyMap := AddSDTM(AuburyMapDDTM);
SetDTMName(DTMAuburyMap, 'Aubury Map DDTM');
//For some reason it tried to click @ quest tab?
if FindDTMRotated(DTMAuburyMap, P.x, P.y, mmx1, mmy1, mmx2, mmy2-5, -pi/2, pi/2, pi/60, afound) then
begin //should do some checks here to make sure it isn't too far of from mage symbol..
writeln('Found Aubury store using offset DDTM!');
if (FindMagicSymbol(P2)) then
begin
if Distance(p2.x, p2.y, p.x, p.y) > 15 then //can be tweaked
begin
writeln('Distance too big. Falling back to magic symbol!');
P := P2;
end;
result := true;
end;
FreeDTM(DTMAuburyMap); //Thanks to Wizzup's leak finder, else wouldnt have found this one.
exit;
end;
FreeDTM(DTMAuburyMap);
result := FindMagicSymbol(P); //Fallback
end;
Function FindBankers(Var Bank: TPoint; Var Angle: Extended): Boolean;
Var
I: Integer;
B, gB: TPointArray;
aTPA: T2DPointArray;
Begin
Result := False;
//FindColorsSpiralTolerance(MMCX, MMY2, B, 785125, MMX1, MMY1, MMX2, MMY2, 0);
B := GetMiniMapDots('npc');
aTPA := SplitTPA(B, 10);
SortATPASize(aTPA, True);
If Length(aTPA) = 0 Then
Exit;
B := aTPA[0];
For I := 0 To High(B) - 1 Do
Begin
If (Abs(B[I].Y - B[I + 1].Y) < 15) And (Abs(B[I].X - B[I + 1].X) < 60) Then
Begin
SetLength(gB, Length(gB) + 1);
gB[High(gB)] := B[I];
If High(gB) > 3 Then // 4 bankers.
Begin
Bank := MiddleTPA(gB);
Bank.Y := Bank.Y - 5;
Angle := Degrees(ArcTan2(gB[0].y - gB[High(gB)].y, gB[0].x - gB[High(gB)].x)) + 90;
If Angle < 0 Then
Angle := 90 - (Angle * -1) + 270;
Result := True;
Exit;
End;
End
Else
SetLength(gB, 0);
End;
End;
Function Randomize(x, Randomness: Integer): Integer;
Begin
Result := RandomRange(X - Randomness, X + Randomness);
End;
Function AtMine: Boolean; //Counts the black to see if we are in the mine
Var
TPA: TPointArray;
Begin
ColorToleranceSpeed(0);
FindColorsTolerance(TPA, 65536, MMX1, MMY1, MMX2, MMY2, 7);
ColorToleranceSpeed(1);
Result := Length(TPA) > 2000;
{ if (result) and (BlackOffset = -1) then
begin //fck this
BlackColors := GetColors(TPA);
ClearSameIntegers(BlackColors);
for i := 0 to high (BlackColors) do
begin
FindColorsTolerance(TPA, BlackColors[i], mmx1, mmy1, mmx2, mmy2, 0);
if (length(TPA) > maxcount) then
begin
BlackOffset := BlackColors[i];
maxcount := Length(TPA);
end;
end;
Writeln('Calculated black offset = '+ToStr(BlackOffset));
end; }
End;
function FindPortal(var cx, cy: Integer): Boolean; //by euphemism, thanks!
var
Area, ColorSpeed, EdgeColor, EdgeTol, GroundColor, GroundTol, I, Match,
WallColor, WallTol: Integer;
TestPoint: TPoint;
EdgeHue, EdgeSat, GroundHue, GroundSat, WallHue, WallSat: Extended;
CharBox, AreaBox, SearchBox: TBox;
CharTPA, ColorsTPA, NewTPA, EdgeTPA, SearchTPA: TPointArray;
ResultsATPA, NewATPA: T2DPointArray;
begin
ColorSpeed := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetToleranceSpeed2Modifiers(0.37, 1.57);
Match := 0;
Result := False;
CharBox := IntToBox(MSCX - 14, MSCY - 21, MSCX + 12, MSCY + 16);
CharTPA := TPAFromBox(CharBox);
//SearchBox := IntToBox(MSX1, MSY1, MSX2, MSY2);
//SearchBox := IntToBox(201, 123, 320, 231); //FASTER, BUT THIS ONLY WORKS IF YOU ARE ADJACENT TO THE PORTAL
SearchBox := IntToBox(MSCX - 80, MSCY - 80, MSCX + 80, MSCY + 80);
SearchTPA := TPAFromBox(SearchBox);
GroundColor := 7047023; GroundHue := 0.72; GroundSat := 0.22; GroundTol := 43;
WallColor := 16180721; WallHue := 3.42; WallSat := 7.34; WallTol := 4;
EdgeColor := 10391949; EdgeHue := 0.16; EdgeSat := 0.23; EdgeTol := 28;
SetToleranceSpeed2Modifiers(GroundHue, GroundSat);
if not FindColorsTolerance(NewTPA, GroundColor, SearchBox.x1, SearchBox.y1, //Finds ground colours
SearchBox.x2, SearchBox.y2, GroundTol) then
Exit;
SetToleranceSpeed2Modifiers(WallHue, WallSat); //Finds wall colours
FindColorsTolerance(ColorsTPA, WallColor, SearchBox.x1, SearchBox.y1,
SearchBox.x2, SearchBox.y2, WallTol);
ColorsTPA := CombineTPA(ColorsTPA, NewTPA); //Combine both
SetToleranceSpeed2Modifiers(EdgeHue, EdgeSat);
FindColorsTolerance(EdgeTPA, EdgeColor, SearchBox.x1, SearchBox.y1,
SearchBox.x2, SearchBox.y2, EdgeTol);
//Add edge colours, too
AppendTPA(ColorsTPA, EdgeTPA);
NewTPA := ClearTPAFromTPA(SearchTPA, ColorsTPA); //SearchTPA is the entire box we are searching in,
ColorsTPA := ClearTPAFromTPA(NewTPA, CharTPA); //We remove our own character and all other points from it
ResultsATPA := SplitTPA(ColorsTPA, 1);
SetLength(NewATPA, 0);
for I := 0 to High(ResultsATPA) do //This thing is still a miracle to me
begin
AreaBox := GetTPABounds(ResultsATPA[i]);
Area := ((AreaBox.X2 - AreaBox.X1) * (AreaBox.Y2 - AreaBox.Y1));
if (InRange(Area, 500, 1500) and (InRange(Length(ResultsATPA[i]), 250, //Probably filters based on not being too small/large
1200))) then
begin
SetLength(NewATPA, Length(NewATPA) + 1);
NewATPA[Match] := ResultsATPA[i];
Inc(Match);
end;
end;
if Length(NewATPA) = 0 then //When no points left, no point to contine
Exit;
SortATPAFromMidPoint(NewATPA, IntToPoint(MSCX, MSCY));
for I := 0 to High(NewATPA) do //Regular (A)TPA iteration
begin
TestPoint := MiddleTPA(NewATPA[i]);
MMouse(TestPoint.x, TestPoint.y, 5, 5);
if WaitUpTextMulti(['Enter', 'Portal', 'nter', 'ortal', 'er P'], 500) then
begin
{$IfDef SMART}
Smart_DrawDotsEx(True, NewATPA[i], clFuchsia); //Flashes the points, though noone watches it.
Wait(100);
SMART_ClearCanvas;
{$EndIf}
Result := True;
cx := TestPoint.x;
cy := TestPoint.y;
Break;
end;
end;
end;
Function DoorClosedWizzup: Boolean;
Var
TP: TPoint;
TPA: TPointArray;
aTPA: T2DPointArray;
I, c: Integer;
Begin
Result := False;
c := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetColorspeed2Modifiers(0.2, 0.5);
FindColorsTolerance(TPA, 3561057, 3, 3, 515, 336, 8);
//aTPA := TPAToATPAEx(TPA, 50, 50);
aTPA := SplitTPA(TPA, 3);
SortATPAFrom(aTPA, IntToPoint(mscx, mscy)); //noob Wizzup forgot this one -.-'
For I := 0 To High(aTPA) Do
Begin
If Length(aTPA[I]) < 320 Then
Continue;
TP := MiddleTPA(aTPA[I]);
MMouse(TP.X, TP.Y, 0, 0);
Wait(200);
If IsUpText('pen') And IsUpText('oor') Then
Begin
Result := True;
Mouse(TP.X, TP.Y, 0, 0, True);
//FFlag(0);
MFlag;
Break;
End;
End;
ColorToleranceSpeed(c);
SetColorspeed2Modifiers(0.2, 0.2);
End;
function DoorClosedDTM : boolean; //I dont want too many DTMs in here, but Demise likes them so much
var //and if she does the hard work, why would I? ;)
x, y : integer;
aFound : extended;
begin
result := False;
if FindDTMRotated(DTMAuburyDoor, x, y, msx1, msy1, msx2, msy2, -Pi/4, Pi/4, Pi/60, aFound) then
begin
MMouse(x, y, 5, 5);
if IsUpText('pen') and IsUpText('oor') then
begin
Result := True;
ClickMouse2(true);
MFlag;
end;
end;
end;
function DoorClosed : boolean; //'Kapstopfunctie'
begin
writeln('Opening door!');
if DoorClosedDTM then
result := true
else if DoorClosedWizzup then
result := true
else
result := false;
end;
Function FindArrow: Boolean;
Var
x, y: Integer;
Begin
Result := False;
{ If NewAutoColorWorked Then //always returns false
If FindColor(x, y, srl_AutoGetColor('transport'), MMX1, MMY1, MMX2, MMY2) Then //Kicked new autocolor out
Begin
Result := True;
WriteLn('Succesfully used NewAutoColor for FindArrow');
End; }
If Not Result Then
If FindSymbol(x, y, 'transportation') Then
Result := True;
If Result Then
Begin
Mouse(x, y, 4, 4, True);
Wait(1000);
//FFlag(0);
MFlag;
FNRWait(1000);
End;
End;
Procedure BankToAubury; //need to add a dtm to this, symbol really isnt accurate at all
Var
V: TPoint;
T: Integer;
Begin
FindNormalRandoms;
MFNF(Randomize(640, 4), Randomize(140, 4), -1, -1);
Wait(10000); //Walk is indeed something ike 10, 15 seconds
T := GetSystemTime; //As flag isn't visible, this is the right way to do it
While (GetSystemTime - T < 60000) Do //60 sec killswitch again, he seems to love those
Begin
FindNormalRandoms;
If FindAuburyStore(V) Then //used to be symbol. After the first run, uses DTM.
Break;
Wait(500);
End;
If GetSystemTime - T >= 60000 Then
Begin
WriteLn('BankToAuburyTime');
LogOut;
Exit;
End; //It wanted to click at quest tab, wtf.
Mouse(V.X, min(V.Y + 3,mmy2-5), 0, 0, True); //Coords of mage symbol are found above
Wait(500);
//FFlag(0);
MFlag;
Players[CurrentPlayer].Loc := 'Aubury';
End;
Procedure MineToAubury;
Var
x, y, T, T2, I: Integer;
Begin
FNRWait(1000);
T := GetSystemTime;
While GetSystemTime - T < 60000 Do //1 minute killswitch, again
Begin
If GetSystemTime - T > 30000 Then
MakeCompass('E'); //Change compass after 30 secs, might help with portal finding
If Not AtMine Then
Break;
FindNormalRandoms;
If Not FindArrow Then
Begin
WriteLn('MineToAubury - Could not find the transportation symbol. Exiting');
FNRWait(5000);
Continue;
End;
FindNormalRandoms;
For I := 0 To 5 Do //6 tries to find portal
Begin
If FindPortal(x, y) Then
Begin
Mouse(x, y, 0, 0, True);
T2 := GetSystemTime;
While AtMine And (GetSystemTime - T2 < 10000) Do //We should really be out after 10 secs or so
Begin
//FindTalk;
FNRWait(500);
End;
Break;
End;
Wait(250);
End;
FNRWait(1000);
FindNormalRandoms;
End;
If GetSystemTime - T >= 60000 Then //60 secs for portal finding is already quite long imo
Begin
//LogOut;
WriteLn('No Portal!');
LogOut;
Exit;
End;
MakeCompass('N');
End;
function MageSymbolDistance : integer; //Should be replaced by something that works with Aubury shop middle
var
p : TPoint;
begin
if not FindMagicSymbol(p) then
result := MaxInt
else
result := Distance(p.x, p.y, mmcx, mmcy);
end;
Procedure AuburyToBank; //This entire function needs to be redone. It works, but not perfect.
Var
T: Integer;
P: TPoint;
A: Extended;
Begin
T := GetSystemTime;
While GetSystemTime - T < 120000 Do //We'll try to go to bank for 2 minutes
Begin
FindNormalRandoms;
Mouse(665, 30, 8, 8, True); //magic coords, still working in 2012
Wait(Randomize(6500, 500)); //Small wait, as flag has changed a tiny bit
FindAuburyStore(P);
If (FlagDistance < 40) Or (Not FlagPresent) or (Distance(mmcx, mmcy, P.x, P.y) < 10) Then //Distance needs a bit of tweaking..
Begin //This door handling is still the most crappy thing imaginable.
if (Distance(mmcx, mmcy, P.x, P.y) < 15) then
begin
writeln('Distance to store is close.');
if (BlackOffset <> -1) then //I'll just trust it to use the DDTM then..
begin
Mouse(MMCX, RandomRange(MMCY + 5, MMCY + 10), 4, 0, True);
FNRWait(1500);
if DoorClosed then
writeln('Opened door!')
else
writeln('Could NOT open door!');
end;
end else
begin
writeln('No idea what''s going on now, flag is weird but distance to store..');
Mouse(MMCX, RandomRange(MMCY + 5, MMCY + 15), 4, 0, True);
FNRWait(1500);
DoorClosed;
end;
End
Else
Begin
{ T2 := GetSystemTime;
While GetSystemTime - T2 < 8000 Do
Begin
Wait(1000);
FindMagicSymbol(P);
If Distance(P.x, P.y, MMCX, MMCY) > 30 Then
Break;
End;
FFlag(10); }
FNRWait(8000);
FFlag(10);
FindAuburyStore(P);
If Distance(P.x, P.y, MMCX, MMCY) > 30 Then
Break;
End;
If Not FindAuburyStore(P) Then
Break;
If Distance(P.X, P.Y, MMCX, MMCY) > 30 Then
Break;
End;
WriteLn('Out of shop');
//FFlag(0);
MFlag;
If FindBankers(P, A) Then
Begin
writeln('Found bankers using NPC dots!');
Mouse(P.x, P.y, 0, 0, True);
FNRWait(3000);
//FFlag(0);
MFlag;
End
Else
If FindSymbol(P.x, P.y, 'Bank') Then
Begin
writeln('Found bank using symbol!');
Mouse(P.x, P.y, 0, 0, True);
FNRWait(3000);
//FFlag(0);
MFlag;
End Else
Begin
WriteLn('No Bank');
LogOut;
End;
Players[CurrentPlayer].Loc := 'Bank';
End;
Function FindAuburyText: Boolean; //Hard to test this one, or shall we get legits to say
var // FindTalk but modded. //Senventior Disthine Molenko? =)
TPA,Matches : TPointArray;
TempATPA : T2DPointArray;
I,CTS,x,y : integer;
Box : TBox;
begin;
CTS := GetColorToleranceSpeed;
ColorToleranceSpeed(1);
FindColorsTolerance(TPA, 65535, 3, 3, 515, 336, 0);
if FindTPAinTPA(aubtpa ,TPA,Matches) then //Length check inside the function ;)
For I := 0 to High(Matches) do //This is all real magic to me..
begin;
FindColorsTolerance(TPA,65535,3, Matches[I].y - 1,516,Matches[I].y + 14,0);
if High(TPA) < 0 then
Continue;
TempATPA := FindGapsTPA(TPA,10);
if Length(TempATPA) > 1 then
begin;
SetLength(TPA,Length(TempATPA));
For x := 0 to High(TempATPA) do
begin;
Box := GetTPABounds(TempATPA[x]);
TPA[x] := Point((Box.x2 + Box.x1) shr 1, Box.y2);
end;
SortTPAFrom(TPA,Point(Matches[I].x,Matches[I].y));
x := TPA[0].x;
y := TPA[0].y;
end else
begin;
Box := GetTPABounds(TempATPA[0]);
x := (Box.x2 + Box.x1) shr 1;
y := Box.y2;
end;
y := y + 8;
MMouse(x, y, 0, 0);
Wait(100 + Random(50));
if IsUpTextMultiCustom(['Talk','lk-to']) then //Remember kids, 'alk' matches both Talk AND Walk
begin
GetMousePos(x, y);
Mouse(x, y, 0, 0, False);
Wait(450 + Random(125));
If ChooseOptionMulti(['ele', 'port']) Then
Begin
Result := True;
Exit;
End;
end;
end;
ColorToleranceSpeed(CTS);
end;
Function FindAubury: Boolean; //Not the best!
Var
I, T, cts: Integer;
P: TPoint;
PA: TPointArray;
aPA: T2DPointArray;
Begin
Result := False;
If FindAuburyStore(P) Then //This part locates inside his shop
Begin
If (Distance(P.x, P.y, MMCX, MMCY) > 15) Or (Random(20) = 0) Then
Begin
Mouse(P.x + 3, P.y + 10, 2, 2, True);
Wait(1000);
//FFlag(0);
MFlag;
wait(randomize(1200, 200));
End;
End;
If FindAuburyText Then
Begin
Result := True;
Exit;
End;
cts := GetColorToleranceSpeed;
ColorToleranceSpeed(1);
FindColorsTolerance(PA, 6450290, MSX1, MSY1, MSX2, MSY2, 3); //tolerance seems low
//writeln(inttostr(length(pa))); //but is severly optimized
aPA := TPAToATPA(PA, 50);
SortATPAFrom(aPA, IntToPoint(mscx, mscy)); //Should do MiddlesATPA and then SortTPA (faster)
//writeln(inttostr(length(apa)));
For I := 0 To High(aPA) Do
Begin
//Wait(200);
If AtMine Then
Begin
Result := True;
Break;
End;
If Length(aPA[I]) < 3 Then
Continue;
P := MiddleTPA(aPA[I]);
MMouse(p.X, P.Y, 3, 3);
Wait(150); //Small wait really necessary
writeln('ut: '+rs_GetUpText);
If Not IsUpTextMultiCustom(['bury', 'Talk']) Then //Bug-fix! alk fits 'Walk', too
Continue;
GetMousePos(P.X, P.Y);
Mouse(P.X, P.Y, 0, 0, False);
Wait(50);
//writeln('here');
// writeln(GetChooseOptions('All'));
If Not ChooseOptionMulti(['elep', 'ort', 'Tel']) Then //Here, this fixes some glitching
begin
Continue;
end;
T := GetSystemTime;
While GetSystemTime - T < 15000 Do
Begin
Wait(500);
If AtMine Or (Not FindMagicSymbol(P)) Then //Good enough, it's just location checking
Break;
End;
Result := GetSystemTime - T < 10500;
If AtMine Then
Result := True;
If Result Then
Break;
End;
ColorToleranceSpeed(cts);
End;
Function GetCurrentTPA: TPointArray;
Var
cts: Integer;
Begin
cts := GetColorToleranceSpeed;
ColorToleranceSpeed(1);
FindColorsTolerance(Result, clWhite, MMX1, MMy1, MMX2, MMY2, 421); //Matches everything besides pure black
ColorToleranceSpeed(cts);
End;
Function ScanMM(Const TPA: TPointArray; SD, ED, MinR, MaxR: Integer): Integer; //Not used anymore with new cool mine handling
Begin
FilterPointsPie(TPA, SD, ED, MinR, MaxR, MMCX, MMCY);
Result := Length(TPA);
{$IFDEF DEBUG} DebugMM(TPA); {$ENDIF}
End;
Function AdeptDegree(CompassAngle: Extended; Degree: Integer): Integer; //idem dito, but I like it
Begin
Result := Round(Abs(CompassAngle + Degree));
While Result > 360 Do
Result := Result - 360;
End;
function AmountOfGaps(ar : TBoolArray) : integer; //Better name: amount of transitions
var
prevone : boolean;
i : integer;
begin
prevone := ar[0];
result := 0;
for i := 1 to high(ar) do
begin
if ar[i] <> prevone then
inc(result);
prevone := ar[i];
end;
result := result;
end;
procedure StartStopGap(ar : tbooleanarray; var start, stop : integer); //Not used.
var //could (in theory) be used for quadrant detection
prevone : boolean;
i : integer;
begin
prevone := ar[0];
for i := 1 to high(ar) do
begin
if ar[i] <> prevone then
begin
start := i;
prevone := ar[i];
break;
end;
end;
for i := i to high(ar) do
begin
if ar[i] <> prevone then
begin
stop := i;
prevone := ar[i];
break;
end;
end;
end;
procedure WalkToMiddleRoom; //No checks, nothing. Just plain clickin'
var
TPA : TPointArray;
p : TPoint;
begin
ColorToleranceSpeed(2); //ACA obviously
SetColorSpeed2Modifiers(1.46, 0.39); //dark grey colour in the mine
FindColorsTolerance(tpa, 10461335, MMX1, MMY1, MMX2, MMY2, 7)
ColorToleranceSpeed(1);
SetColorspeed2Modifiers(0.2, 0.2);
p := MiddleTPA(tpa); //should do
Mouse(p.x, p.y, 4, 4, true);
wait(500);
//FFlag(0);
MFlag;
Wait(500);
end;
function FindEss : Boolean; //ACA love
var
arP : TPointArray;
ararP: T2DPointArray;
arL, i : Integer;
P: TPoint;
// fx, fy : integer;
begin
ColorToleranceSpeed(2);
SetColorSpeed2Modifiers(0.08, 0.17);
if not(FindColorsTolerance(arP, 8618897, MSX1, MSY1, MSX2, MSY2, 29)) then
begin
Writeln('Failed to find the color, no object found.');
ColorToleranceSpeed(1); //no need to store cts, 1 is always good
SetColorSpeed2Modifiers(0.2, 0.2);
Exit;
end;
ararP := SplitTPAEx(arP, 3, 3); //SLLOOOOWWWW, as there are LOTS of points
arL := Min(4, High(ararP)); //and 5 is already a lot, it should find it in 1 try
SortATPASize(ararP, true); //hey, I did this line of code myself, not ACA
for i := 0 to arL do
begin
if (Length(ararP[i]) < 10) then Continue;
P := MiddleTPA(ararP[i]);
MMouse(P.x, P.y, 5, 5);
Wait(100 + Random(100));
if (IsUpTextMultiCustom(['ine', 'ure', 'ssen'])) then
begin;
Result := True;
ClickMouse2(True); //mine it!
Break;
end;
end;
ColorToleranceSpeed(1);
SetColorSpeed2Modifiers(0.2, 0.2);
if (i = arL + 1) then
begin
Writeln('FindObject could not find object.');
Exit;
end;
end;
function LocateInsideEssMine : boolean; //returns true if @ mine
var //VERY BAD CODING PRACTICE INSIDE!!!!
BlackArr : array [mmx1..mmx2] of array [mmy1..mmy2] of boolean;
Angles : array[0..359] of boolean;
i : integer;
radius, angle : integer;
tpa : TPointArray;
// p : TPoint;
x, y : integer;
aFound : extended;
begin
//setupsrl;
ColorToleranceSpeed(0);
FindColorsTolerance(tpa, 0, mmx1, mmy1, mmx2, mmy2, 7); //Find all the black!
ColorToleranceSpeed(1);
for i := 0 to high(tpa) do
BlackArr[tpa[i].x][tpa[i].y] := True;
for radius := 74 downto 50 do //Minimap is 75 radius. 50 was determined experimentally
for angle := 0 to 359 do
begin
x := round(Cose(angle-90)*radius+mmcx); //cose and sine use lookup tables, so pretty quick
y := round(Sine(angle-90)*radius+mmcy);
if (BlackArr[x][y]) then //Reason for using if, we don't want to set it to false, only to true
Angles[angle] := True;
end;
writeln(AmountOfGaps(angles));
if(AmountOfGaps(angles) > 4) then //Only then can it really be middle..
begin
writeln('We are standing in the middle');
if (not(FindDTMRotated(MiddleDTM1, x, y, MMX1, MMY1, MMX2, MMY2, -Pi, Pi, Pi/360, aFound))) then //Look what I did here
if (not(FindDTMRotated(MiddleDTM2, x, y, MMX1, MMY1, MMX2, MMY2, -Pi, Pi, Pi/360, aFound))) then
begin
writeln('Force-walking to the middle of room..');
WalkToMiddleRoom;
if FindSymbol(x, y, 'transportation') then
begin
writeln('We weren''t in the middle indeed');
//WalkToMiddleRoom;
writeln('should be in middle of mine now');
if (not(FindEss)) then
begin
NoEssFound := True;
WriteLn('No Essence Fake Middle');
end else
Result := True; //best thing is, wizzup's code doesnt even use this result
exit;
end;
writeln('Location detection failed! No middle and no DTMs');
Players[0].Loc := 'NoMine';
result := False;
exit;
end; //else
writeln('We are standing at quadrant: '+inttostr(((Trunc(FixD(ArcTan2(y - mmcy, x - mmcx) * 180.0 / pi) / 90.0))+3)mod 4)); //thanks to mixster
x := Round(Cose((((Trunc(FixD(ArcTan2(y - mmcy, x - mmcx) * 180.0 / pi) / 90.0))+2)mod 4)*90+RandomRange(40,50))*randomrange(48,53))+mmcx; //this will randomize like wtf xd
y := Round(Sine((((Trunc(FixD(ArcTan2(y - mmcy, x - mmcx) * 180.0 / pi) / 90.0))+2)mod 4)*90+RandomRange(40,50))*randomrange(48,53))+mmcy; //x and y are both randomly generated
Mouse(X, Y, 4, 4, True); //random random random
Wait(2000);
//FFlag(0);
MFlag;
Wait(500);
if(not(FindEss)) then //Does at most 5 "wacky" movements, low cost to pay compared to clicking minimap and waiting 5 seconds
begin
WalkToMiddleRoom; //Usu
//Wait(Randomize(750, 250)); //should work with this, too
if (not(FindEss)) then
begin
NoEssFound := True;
WriteLn('No Essence');
//NoEssenceFound := True;
end;
end;
end else
// if(AmountOfGaps(angles) = 2) then
begin
writeln('We are standing in a room');
writeln('Fortunately we can walk to the middle.');
WalkToMiddleRoom;
writeln('should be in middle of mine now');
if (not(FindEss)) then
begin
NoEssFound := True;
WriteLn('No Essence Corner');
end;
{writeln('We can now determine exct loc') //Useless. Essmine rotates so we should not rely on that
StartStopGap(angles, start, stop);
writeln('START: '+inttostr(start)+', STOP: '+inttostr(stop));
writeln('Location: '+locationnames[(start+stop) div 180]);}
end
end;
Function EssenceCount: Integer;
{Var
I: Integer;
TPA: TPointArray;
B: TBox; }
Begin
{ Result := 0;
For I := 1 To 28 Do
Begin
B := InvBox(I);
FindColorsTolerance(TPA, 65536, B.X1, B.Y1, B.X2, B.Y2, 0);
If Length(TPA) = 82 Then //doesnt work anymore
Result := Result + 1;
End; }
result := InvCount; //Too bad if your pickaxe isnt equipped
End;
Procedure Bank;
Var
I: Integer;
P: TPoint;
A: Extended;
TempEss: Integer;
Begin
//ReportVars[1] := ReportVars[1] + 1; // Banks
Players[CurrentPlayer].Banked := Players[CurrentPlayer].Banked + 1;
For I := 0 To 2 Do
If OpenBankFast('veb') Then
Break
Else
If FindBankers(P, A) Then
Begin
Mouse(p.x, p.y, 0, 0, True);
Wait(4000);
//FFlag(0);
MFlag;
Wait(1500);
End;
If Not BankScreen Or PinScreen Then
Begin
LogOut;
Players[CurrentPlayer].Loc := 'NoBank';
Players[CurrentPlayer].Active := False;
Exit;
End;
TempEss := EssenceCount;
EssenceMined := EssenceMined + TempEss;
//ReportVars[0] := ReportVars[0] + TempEss;
Players[CurrentPlayer].Integers[0] := Players[CurrentPlayer].Integers[0] + TempEss;
If Players[CurrentPlayer].Booleans[0] Then
Deposit(1, 28, True)
Else
Deposit(2, 28, True); //blindly assumes it is in spot 1
if (random(3) = 1) then //no need to close it all the time Wiz
CloseBank;
End;
Procedure PlayerReport;
Var
Active, Rand: string;
I: Integer;
Begin
For I := 0 To High(Players) Do
Begin
If Players[i].Active Then
Active := 'T'
Else
Active := 'F';
If Players[i].Rand <> '' Then
Rand := '; Rand: ' + Players[i].Rand
Else
Rand := '';
WriteLn((IntToStr(I)) + ' : ' + Players[I].Nick + ' = ' +
Active + '; ' + Players[I].Loc + rand + '; B: ' + IntToStr(Players[I].Integers[0])
+ ' Essence;'+ ' M : ' + IntToStr(Players[I].Level[15]));
End;
End;
Procedure ProgressReport;
Begin
WriteLn('----------------------------');
WriteLn('');
WriteLn('Wizzup? and Markus Essence Miner, Version ' + VersionNumber);
WriteLn('');
WriteLn('Worked for '+ TimeRunning);
WriteLn('Mined ' + IntToStr(EssenceMined) + ' Essence');
If Abyss > 0 Then WriteLn('Solved ' + IntToStr(Abyss) + ' abyssal random events.');//and it will never solve them cause the solver was removed ^-^
WriteLn('');
WriteLn('----------------------------');
WriteLn('');
PlayerReport;
WriteLn('');
WriteLn('----------------------------');
SRLRandomsReport;
End;
Procedure ScriptTerminate;
Begin
ProgressReport;
End;
Function GetAndSetAnyReferenceColor: Boolean; //if I could get black here, I'd do it.
//Var
// c: integer;
Begin
NewAutoColorWorked := False;
result := False;
Exit;
{
c := AutoColor(srl_RockColor);
If c > 0 Then
Begin
SetAutoColorReference('grey rock', c);
WriteLn('Got the color using the grey rock');
NewAutoColorWorked := True;
Result := True;
Exit;
End; }
End;
Procedure InitPlayer;
{
Var
I: Integer; }
Begin
{For I := 1 To 5 Do
If Not Players[CurrentPlayer].Booleans[I] Then
Begin
Case I Of
1: SetGraphics(4, '', '' ,'', '', '', '', '', '');
2: Retaliate(False);
3: SetAudio(0, 0, 0, Mono);
End;
Players[CurrentPlayer].Booleans[I] := True;
End;}
GetAllLevels;
SetChat('on',1);
SetChat('friends',2);
SetChat('on',3);
SetAngle(SRL_ANGLE_HIGH);
End;
Procedure SetupScript;
//Var
// I: Integer;
Begin
// SRLID := SRL_ID;
//SRLPassword := SRL_PASS;
// For I := 1 To 19 Do
// ReportVars[I] := 0;
//ScriptID := '51';
DeclarePlayers;
LoginPlayer;
InitPlayer;
//BlackOffset := -1;
//Thanks to Demise for restoring my faith in DTMs :)
MiddleDTM1 := DTMFromString('mlwAAAHicY2dgYChhYmCIBuIMIK4B4g4gjgHiOiAOAcr7A7'+
'ELEFsBcTIQxwGxFxD///+fwVyNAwW7aAkyfH79kWECIwMDPwN2zIgHQwEAMRYOKA==');
MiddleDTM2 := DTMFromString('mggAAAHicY2NgYKhiYmAoAOIGIG4H4glAnAPE4UA5JyB2BW'+
'IfIM4G4kwgfvTmHYO9gTCDkQ4XGG/Zuw/Mn8DIwMDPgIkZcWAIAAAOAAyf');
{DTMAuburyMap := DTMFromString('mwQAAAHic42RgYNBlZGBQA2I9IJYF4v9AMWEgHQzEBkCs'+ //Thanks Demise, for this one
'AcS3gWIHofg6ED9kgKh7DMRcQPlNQDop1IwhxpgbjP1ddRg8HQ0YnKxUGb4zMjFEhIcx/P/PySA'+
'JVEcIMxGB4QAAolMSVg==');}
DTMAuburyDoor := DTMFromString('mAAEAAHic42FgYDAGYnkodoVikJgClG0CxEZAHM8AAfx'+ //Thanks Demise, love you!
'AzAvEAlA2NxBLA7EMEEsBsSZUHcg8USDOjrFgyIoxZyhIsGTIjDJlSI0wZciIMmPIibNkiAs0ZN'+
'DVVGII8dBh0NYRZ6gNlgObSQpmBGImIjAbFCMDAJFbDpI=');
SetDTMName(MiddleDTM1, 'Middle DTM 1');
SetDTMName(MiddleDTM2, 'Middle DTM 2');
SetDTMName(DTMAuburyDoor, 'Aubury door DTM');
End;
Var
T, T2, I:integer;
begin
//Smartsetup(SmartPrefix, true, true, false);
//Settargetdc(smartgetdc);
AubTPA := CreateTPAFromText('isthin', UpCharsEx);
Smart_Server := 52;
Smart_Signed := True;
Smart_SuperDetail := False;
SetupSRL;
SetupScript;
//LoadLocations;
//SetupNewAutoColor;
GetAndSetAnyReferenceColor;
Repeat
If Players[CurrentPlayer].Loc = 'Bank' Then
BankToAubury;
If Players[CurrentPlayer].Loc = 'Aubury' Then
Begin
T2 := GetSystemTime;
While Not AtMine Do
Begin
If GetSystemTime - T2 > 180000 Then
Begin
Players[CurrentPlayer].Loc := 'NoAubury';
Break;
End;
//DoorClosed; //ffs, walk to the right place first ;)
If FindAubury Then
Begin
T := GetSystemTime;
While (Not AtMine) and (GetSystemTime - t < 10000) Do Wait(250);
If AtMine Then
Break;
End;
Wait(500);
End;
Players[CurrentPlayer].Loc := 'Mine';
End;
If Players[CurrentPlayer].Loc = 'Mine' Then
Begin
Wait(500);
// If InAbyss Then
// SolveAbyss;
LocateInsideEssMine;
T := GetSystemTime;
T2 := GetSystemTime;
While (GetSystemTime - T < 180000) And (InvCount < 28) Do
Begin
If NoEssFound Then
Begin
WriteLn('We did not find any essence...');
NoEssFound := NoEssFound xor NoEssFound; //wizzup's way of saying = false;
Break;
End;
If GetSystemTime - T2 > 60000 Then
Begin
I := Random(14) + 21;
If I = tab_Inv Then I := tab_Stats;
GameTab(I);
Wait(RandomRange(200, 4000));
GameTab(tab_Inv);
T2 := GetSystemTime;
End;
Wait(1000);
If LevelUp Then
Begin
WriteLn('You levelled up, congratulations!'); //Wizzup? wasn't nice here, but I am
Break;
End;
If FindNormalRandoms Then
Begin
T := GetSystemTime;
While GetSystemTime - T < 5000 Do
Begin
Wait(250);
FindNormalRandoms;
End;
End;
End;
MineToAubury;
AuburyToBank;
Bank;
End;
ProgressReport;
If Not LoggedIn Then
Begin
NextPlayer(False);
InitPlayer;
Continue;
End;
If Players[CurrentPlayer].Banked Mod Loads = 0 Then
Begin
NextPlayer(True);
InitPlayer;
Continue;
End;
Until False;
End.
Hope it works, Psyonity
