Code:
{\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{------------------------------------------------------------------------------}
{//\\//\\//\\//\\//\\//\\// Starting Location \\//\\//\\//\\//\\//\\//\\//}
{------------------------------------------------------------------------------}
{\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{//\\//\\//\\ Start in Nordcarn Storage. \\//\\//\\//}
{\\//\\//\\// Compass needs to point North. //\\//\\//\\}
{//\\//\\//\\ Use BloodSucker's maps. \\//\\//\\//}
{//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//}
{------------------------------------------------------------------------------}
program HarvCoalWS;
{.Include SRL\SRL.SCAR}
var
{Global variable counters used through out the script}
x, y, i, Width, Height, HarvEvents, Loads,
UDLFile,LastX, LastX2, Tries : integer;
{DTMs used through out the script}
var
dtmStoExitMap, dtmArriveAtStoExit, dtmStoMap,
dtmWSExitMap, dtmArriveAtWSExit, dtmWSCaveMap,
dtmArriveWSCaveMap, dtmCaveCoalMap,
dtmArriveAtCaveCoal, dtmNordcarnMap, dtmWSMap,
dtmCoalCaveMap,dtmCoalMap, dtmArriveCoalMap,
dtmCaveExitMap, dtmArriveCaveExitMap,
dtmNExitMap, dtmArriveNExitMap, dtmNStoMap,
dtmArriveNStoMap, dtmPickAxe : integer;
{Strings used through out the script}
Text, DebugText : string;
{TPAs used through out the script for color searching}
tpaStoExit, tpaWSExit, tpaStoril : TPointArray;
ATPA : T2DPointArray;
const
{Player X color on map}
PlayerMap = 16711680;
{Script details}
Version = '1.0';
Title = 'WhiteStone Coal Miner';
function CheckHarving: Boolean; forward;
procedure ExitSto; forward;
procedure GotoWSExit; forward;
procedure LoadDTMs;
begin
dtmStoExitMap := DTMFromstring('78DA63FCC6C4C010C68002FEFFFF0FA619A17' +
'CC6B74035AEA86A440AB551D5A803D504A1AA61F0154055B31EA8' +
'E63FAA9262252E543527816A6632A2A8E1E0B886A20600E8000BA' +
'C');
dtmArriveAtStoExit := DTMFromstring('78DA63FCC8C4C010CC8006FE834946288FF13' +
'B504D189A8AFF686A34806ABC51D58839F3A1AAD90754F317554D' +
'A21C17AA9AE34035331951D470705C4355C3C6CCC0E0C08015C0D' +
'4000088D90C52');
dtmStoMap := DTMFromstring('78DA633CC0C4C060C180023E7FFE04A619A17' +
'CC6EB403521A86AAE5D3C86AA660B50CD4C4614351C1CD750D5C8' +
'0059CDA8E664AE504055F301C8B2614251F3FFFF7F143500DC050' +
'FAA');
dtmWSExitMap := DTMFromString('78DA636C61646058CDC4800CD8D998C134239' +
'4CFF817C85AC288A2E6F9670E5435654033D250D5043D16405573' +
'05A8660EAA5D4B533551D58401E57FA02861785FCB80AA663B908' +
'84235E7FFFFFF286A006C74106B');
dtmArriveAtWSExit := DTMFromString('78DA636C60646058C5C4800AFE834946288FF' +
'12A507E3EAA9AA5A99AA86ACA81F2698C286A821E0BA0AA0903AA' +
'F98E6AD3FB5A0654357F81AC25A8E63CFFCC81AA661B90884475C' +
'FFFFFA86E0600C5411157');
dtmWSCaveMap := DTMFromString('78DA633CC8C8C0A0C98002DEBF7B0BA619A17' +
'C461E20CB0A55CD8AA4C9A86AB8812C2F543502693350D58058E1' +
'A86A5A759450D570025925A86AF65D54455523006475A2AA99162' +
'88CA20600D28D0BFB');
dtmArriveWSCaveMap := DTMFromString('78DA633CC0C8C0A0C98006FE834946288F911' +
'DC8B24155F1BDEB1AAA1A0E20CB1B558DC4ACE7A86A5881AC6254' +
'35CFDFF3A1AAE106B2BA51D5BC6AE54555630864CD405513F55C0' +
'2450D0097D00D11');
dtmCaveCoalMap := DTMFromString('78DA63B4646460E867624006DEAE7A609A11C' +
'A67BC07244251D5FCFFFF1F55CD5120B1014509032BCB7754352F' +
'81AC5FA86A0C6719A2AAB902B4270955CD39160E543577806A825' +
'1DD33B1C412450D0011DF0FA0');
dtmCoalMap := DTMFromString('78DA63B461646098C8C4800CECAC34C034239' +
'4CF780C486C4151C2E0E21E8AAAE63990F51B558DC95443543597' +
'81F624A2AAB9C5C281AAE60E504D10AA7B625A6550D4000008B20' +
'AFD');
dtmArriveCoalMap := DTMFromString('78DA6334676460E863624005FFC1242394C77' +
'81448AC4353C2F21D55CD0B20EB37AA12C35986A86AAE00ED4942' +
'55738E850355CD5DA09A2054F7CC29B144510300493E0BAE');
dtmNordcarnMap := DTMFromstring('78DA63FCC5C0C07094910119FCFFFF1F4CC34' +
'4196F0289285435A275BB50D57C00B23EA1286190CE5B84AAA68C' +
'8981210DD59CA0C702A86AFE0159CB51D53CFFCC81AAE62AD09CF' +
'94C286A96A66AA2A80100E0E912B1');
dtmWSMap := DTMFromString('78DA6364676460B0664001DFBBAE816946289' +
'FF11D90704655A3B2E811AA1A0E20CB17558DC4ACE7A86A7E0189' +
'705435EF253850D53C0512A9A86ADE5672A1AA390124661330870' +
'DC82A4755F3FC3D9A1A1E20AB0B55CDEB461E5435CA40D67C5435' +
'4B25D0FC650C644D435513F55C02450D00ACB117F8');
dtmCaveExitmap := DTMFromString('78DA637CC0C0C0E0C5C4800C4CF414C034239' +
'4CF781B4838A3AAF9F8F123AA9AA34062038A12065696EFA86A9E' +
'0359BF50D5984C3544557305684F12AA9A732C1CA86AEE00D504A' +
'1BA27A65506450D0008AA0F40');
dtmArriveCaveExitMap := DTMFromString('78DA63BCC5C0C0E0CAC4800AFE834946288FF' +
'12890D880AA8295E53BAA9A9740D62F543586B30C51D55C06DA93' +
'88AAE6160B07AA9A7740D60C461435DFCF67A3AAB903342708D5C' +
'D31AD32286A00BE2B0F86');
dtmNExitMap := DTMFromString('78DA639CC7C8C0A0C28002BE7EF90AA619A17' +
'C464E20CB0A55CDF7AE6BA86AFE0089505435FDF2E2A86AD881AC' +
'12543537EE0BA0AAE107B23A51D53C2A144155A30264CD4455B35' +
'4E2398A1A00039E0F04');
dtmArriveNExitMap := DTMFromString('78DA639CC3C8C0A0C68006FE834946288F911' +
'DC8324755F1ADEB2AAA1A3620CB1D558D58CB615435FF804418AA' +
'9A246D0554359C405609AA9A7D175551D5F001599DA86A5EE573A' +
'0AA5105B266A1AA992C731C450D0028FA0E72');
dtmNStoMap := DTMFromstring('78DA63BCC4C4C030018891407E862B986684F' +
'219AF01E5E7A0AA599CAA89AAE61F90B59C1145CDF3CF1CA86ACA' +
'8066A4A1AA097A2C80AA868F9981E11D03AA391AA8E600000F1F0' +
'CF7');
dtmArriveNStoMap := DTMFromstring('78DA63BCC8C4C030118851C07F30C908E5315' +
'E05CACF4355B334551355CD3F206B19238A9AE79F3950D59402CD' +
'48455513F45800550D1F3303C33B54D73CD740350700FC6E0CDA');
dtmPickAxe := DTMFromstring('78DA638C606660D8C9C8800C4AFC55C0344C9' +
'43115A86615AA9A505B7554359940356B50D5D85A98A1AA4902AA' +
'598AAA46524212554D0650CD325435667A6A286A0071210888');
end;
procedure FreeDTMs;
begin
FreeDTM(dtmStoExitMap);
FreeDTM(dtmArriveAtStoExit);
FreeDTM(dtmStoMap);
FreeDTM(dtmWSExitMap);
FreeDTM(dtmArriveAtWSExit);
FreeDTM(dtmWSCaveMap);
FreeDTM(dtmArriveWSCaveMap);
FreeDTM(dtmCaveCoalMap);
FreeDTM(dtmArriveAtCaveCoal);
FreeDTM(dtmWSMap);
FreeDTM(dtmCoalMap);
FreeDTM(dtmArriveCoalMap);
FreeDTM(dtmCaveExitMap);
FreeDTM(dtmArriveCaveExitMap);
FreeDTM(dtmNExitMap);
FreeDTM(dtmArriveNExitMap);
FreeDTM(dtmNStoMap);
FreeDTM(dtmArriveNStoMap);
FreeDTM(dtmPickAxe);
end;
function Full:Boolean;
begin
result := False;
if(GetColor(544, 726) = 4408182) then //Check to see if EMU bar full for anything 7 or less space is full
result := True
else
result := False;
end;
procedure LookEast;
begin
//AddToReport('DBInf - proc LookEast')
MoveMouse(485, 366);
wait(1000 + random(500));
GetMousePos(x, y)
HoldMouseMid(x, y);
wait(1000 + random(500));
MoveMouse(x+28, y);
wait(1000 + random(500));
ReleaseMouseMid(x,y);
wait(1000 + random(500));
end;
procedure LookNorthFromEast;
begin
//AddToReport('DBInf - proc LookNorthFromEast')
MoveMouse(485, 366);
wait(1000 + random(500));
GetMousePos(x, y)
HoldMouseMid(x, y);
wait(1000 + random(500));
MoveMouse(x-28, y);
wait(1000 + random(500));
ReleaseMouseMid(x,y);
wait(1000 + random(500));
end;
procedure PressTab;
begin
//AddToReport('DBInf - proc PressTab');
TypeSend(chr(9));
Wait(2500 + random(100));
end;
procedure OpenInv;
begin
KeyDown(17); //Ctrl key
Sendkeys(chr(105));
KeyUp(17);
end;
function CheckInventoryOpenBMP:Boolean;
var
bmpInventory : integer;
begin
//AddToReport('DBInf - proc CheckInventoryOpenBMP')
result := False;
bmpInventory := LoadBitmap('.\EL\inventory.bmp');
if FindBitmapTolerance(bmpInventory, x, y, 50) then
begin
result:= True
MMouse(x, y, 0, 0);
end
else
begin
result := false
// WriteLn('Inventory Bitmap not found')
OpenInv
wait(1000 + random(300))
end;
FreeBitmap(bmpInventory);
end;
function CheckInventoryOpenDTM:Boolean;
var
dtmInventory : integer;
begin
//AddToReport('DBInf - proc CheckInventoryOpenDTM')
result := False;
dtmInventory := DTMFromstring('78DA633CC9C4C090C8C8800C9A139DC0344C9' +
'4F12CA69A3857035435A7816A5251D5A47819A3AA3901549389AA' +
'A635C919D32E426A6E00D524A3AA59DF1881AAE636A639693E26A' +
'86A3E02D524A1AAD9D81C85AAE637A63907FA1251D5B031033D8B' +
'AA66797508AA1A2EA09A2C5435330B7D51D40000828B19E3');
if FindDTM(dtmInventory, x, y, 0, 0, Width, Height) then
begin
result:= True
MMouse(x, y, 0, 0)
end
else
begin
result := false
// WriteLn('Inventory dtm not found')
OpenInv
wait(1000 + random(300))
end;
FreeDTM(dtmInventory);
end;
procedure InventoryOpen;
begin
if CheckInventoryOpenBMP then
begin
wait(1000 + random(500));
end
else
if CheckInventoryOpenDTM then
begin
wait(1000 + random(500))
end;
end;
function CheckPickAxeBMP:Boolean;
var
bmpPickAxe : integer;
begin
//AddToReport('DBInf - func CheckPickAxeBMP')
result := False;
bmpPickAxe := LoadBitmap('.\EL\PickAxe.bmp');
if FindBitmapTolerance(bmpPickAxe, x, y, 50) then
begin
result:= True
MMouse(x, y, 0, 0)
WriteLn('Found PickAxe BMP')
end
else
begin
result := false
WriteLn('PickAxe Bitmap not found')
OpenInv
wait(1000 + random(300))
end;
FreeBitmap(bmpPickAxe);
end;
function CheckPickAxe:Boolean;
begin
//AddToReport('DBInf - func CheckPickAxeBMP')
InventoryOpen;
Wait(500 + random(300));
if FindDTM(dtmPickAxe, x, y, 0, 0, Width, Height) then
begin
result := true
WriteLn('Found PickAxe DTM')
end
else
begin
result := false
WriteLn('PickAxe DTM not found, trying BMP')
CheckPickAxeBMP
end;
Wait (400 + random(100));
OpenInv;
end;
procedure MapWalkStoExit;
begin
//AddToReport('DBInf - proc MapWalkStoExit')
if FindDTM(dtmStoExitMap, x, y, 0, 0, Width, Height) then
begin
MMouse(x, y, 1, 1)
Wait(1000 + random(100))
Mouse(x, y, 0, 0, True)
end
else
WriteLn('Storage Exit on map not found!');
end;
function CheckStoMap:Boolean;
begin
//AddToReport('DBInf - func CheckStoMap')
result := false;
if FindDTM(dtmStoMap, x, y, 0, 0, Width, Height) then
begin
result := true
end
else
begin
result := false
PressTab
end;
Wait (100 + random(100));
end;
function ArriveAtStoExit:Boolean;
begin
//AddToReport('DBInf - func ArriveAtIron')
result := false;
if FindDTM(dtmArriveAtStoExit, x, y, 0, 0, Width, Height) then
result := true
else
result := false;
Wait(1000 + random(500));
end;
procedure SearchStoDoor;
begin
//AddToReport('DBInf - proc SearchStoDoor');
Tries := 0;
FindColorsSpiralTolerance(x, y, tpaStoExit, 1383487, 378, 361,554, 480, 10);
// WriteLn('tpaStoExit = ' + IntToStr(Length(tpaStoExit)));
if (Length(tpaStoExit) = 0) then
repeat
if (Length(tpaStoExit) = 0) then
begin
Tries := Tries + 1
FindColorsSpiralTolerance(x, y, tpaStoExit, 2955799, 165, 29, 955, 714, 10)
WriteLn('Tried '+ IntToStr(Tries) +' times to find the door!');
end
else
begin
ATPA := TPAToATPAEx(tpaStoExit, 10, 10)
SortATPASize(ATPA, True)
MMouse(ATPA[0][0].x,ATPA[0][0].y,2,2)
Wait(1000 + random(200))
Mouse(ATPA[0][0].x,ATPA[0][0].y,2,2, True)
Wait(1500 + random(500))
Break
end;
until (Tries > 5)
else
begin
ATPA := TPAToATPAEx(tpaStoExit, 10, 10)
SortATPASize(ATPA, True)
MMouse(ATPA[0][0].x,ATPA[0][0].y,2,2)
Wait(1000 + random(200))
Mouse(ATPA[0][0].x,ATPA[0][0].y,2,2, True)
Wait(1500 + random(500))
end;
if (Tries > 5) then
begin
WriteLn('Door not found :(')
ExitSto;
end;
end;
procedure ExitSto;
begin
Wait(1000 + random(500));
CheckStoMap;
Wait(1000 + random(500));
MapWalkStoExit;
while not (ArriveAtStoExit) do
wait(500 + random(200));
// PressTab;
wait(1000 + random(500));
LookEast;
wait(1000 + random(1000));
SearchStoDoor;
Wait(2000 + random(500));
LookNorthFromEast;
end;
function CheckNordcarnMap:Boolean;
begin
//AddToReport('DBInf - func CheckNordcarnMap')
result := false;
if FindDTM(dtmNordcarnMap, x, y, 0, 0, Width, Height) then
begin
result := true
end
else
begin
result := false
PressTab
end;
Wait (1000 + random(100));
end;
procedure MapWalkWSExit;
begin
//AddToReport('DBInf - proc MapWalkStoExit')
if FindDTM(dtmWSExitMap, x, y, 0, 0, Width, Height) then
begin
MMouse(x, y, 1, 1)
Wait(1000 + random(100))
Mouse(x, y, 0, 0, True)
end
else
WriteLn('WS Exit on map not found!');
end;
function ArriveAtWSExit:Boolean;
begin
//AddToReport('DBInf - func ArriveAtIron')
result := false;
if FindDTM(dtmArriveAtWSExit, x, y, 0, 0, Width, Height) then
result := true
else
result := false;
Wait(1000 + random(500));
end;
procedure ClickWSFlag;
begin
//AddToReport('DBInf - proc ClickWSFlag')
Tries := 0;
FindColorsSpiralTolerance(x, y, tpaWSExit, 5325114, 280, 218, 750, 580, 10);
WriteLn('tpaWSExit = ' + IntToStr(Length(tpaStoExit)));
if (Length(tpaWSExit) = 0) then
repeat
if (Length(tpaWSExit) = 0) then
begin
Tries := Tries + 1
FindColorsSpiralTolerance(x, y, tpaWSExit, 6316645, 280, 218, 750, 580, 10)
WriteLn('Tried '+ IntToStr(Tries) +' times!');
end
else
begin
ATPA := TPAToATPAEx(tpaWSExit, 10, 20)
SortATPASize(ATPA, True)
MMouse(ATPA[0][0].x,ATPA[0][0].y,2,2)
Wait(1000 + random(200))
Mouse(ATPA[0][0].x,ATPA[0][0].y,2,2, True)
Wait(1500 + random(500))
Break
end;
until (Tries > 5)
else
begin
ATPA := TPAToATPAEx(tpaWSExit, 10, 20)
SortATPASize(ATPA, True)
MMouse(ATPA[0][0].x,ATPA[0][0].y,2,2)
Wait(1000 + random(200))
Mouse(ATPA[0][0].x,ATPA[0][0].y,2,2, True)
Wait(1500 + random(500))
end;
if (Tries > 5) then
begin
WriteLn('WhiteStone Flag not found :(')
GotoWSExit
end;
end;
procedure GotoWSExit;
begin
Wait(1000 + random(500));
CheckNordcarnMap;
Wait(1000 + random(500));
MapWalkWSExit;
while not (ArriveAtWSExit) do
wait(500 + random(200));
PressTab;
Wait(1000 + random(500));
ClickWSFlag;
end;
function CheckWSMap:Boolean;
begin
//AddToReport('DBInf - func CheckWSMap')
result := false;
if FindDTM(dtmWSMap, x, y, 0, 0, Width, Height) then
begin
result := true
end
else
begin
result := false
PressTab
end;
Wait (1000 + random(100));
end;
procedure MapWalkCave;
begin
//AddToReport('DBInf - proc MapWalkCave')
if FindDTM(dtmWSCaveMap, x, y, 0, 0, Width, Height) then
begin
MMouse(x, y, 1, 1)
Wait(1000 + random(100))
Mouse(x, y, 0, 0, True)
end
else
WriteLn('WS Coal Cave on map not found!');
end;
function ArriveAtCave:Boolean;
begin
//AddToReport('DBInf - func ArriveAtCave')
result := false;
if FindDTM(dtmArriveWSCaveMap, x, y, 0, 0, Width, Height) then
result := true
else
result := false;
Wait(1000 + random(500));
end;
procedure EnterCave;
begin
//AddToReport('DBInf - proc EnterCave')
FindColorsSpiralTolerance(x, y, tpaStoExit, 2105120, 446, 343, 498, 414, 10);
if Length(tpaStoExit) = 0 then FindColorsSpiralTolerance(x, y, tpaStoExit, 1184274, 446, 343, 498, 414, 10);
ATPA := TPAToATPAEx(tpaStoExit, 10, 10);
SortATPASize(ATPA, True);
MMouse(ATPA[0][0].x,ATPA[0][0].y,2,2);
Wait(1000 + random(200));
Mouse(ATPA[0][0].x,ATPA[0][0].y,2,2, True);
Wait(1500 + random(500));
end;
procedure GotoCave;
begin
Wait(1000 + random(500));
CheckWSMap;
Wait(1000 + random(500));
MapWalkCave;
while not (ArriveAtCave) do
wait(500 + random(200));
PressTab;
Wait(1500 + random(500));
EnterCave;
Wait(500 + random(500));
LookEast;
Wait(500 + random(500));
LookEast;
end;
function CheckCoalCaveMap:Boolean;
begin
//AddToReport('DBInf - func CheckCoalCaveMap')
result := false;
if FindDTM(dtmCoalCaveMap, x, y, 0, 0, Width, Height) then
begin
result := true
end
else
begin
result := false
PressTab
end;
Wait (1000 + random(100));
end;
procedure MapWalkCoal;
begin
//AddToReport('DBInf - proc MapWalkCoal')
if FindDTM(dtmCoalMap, x, y, 0, 0, Width, Height) then
begin
MMouse(x, y, 1, 1)
Wait(1000 + random(100))
Mouse(x, y, 0, 0, True)
end
else
WriteLn('Coal on map not found!');
end;
function ArriveAtCoal:Boolean;
begin
//AddToReport('DBInf - func ArriveAtCoal')
result := false;
if FindDTM(dtmArriveCoalMap, x, y, 0, 0, Width, Height) then
result := true
else
result := false;
Wait(1000 + random(500));
end;
procedure SearchCoal;
begin
//AddToReport('DBInf - proc SearchCoal')
FindColorsSpiralTolerance(x, y, tpaStoExit, 2040096, 433, 343, 555, 479, 10);
if Length(tpaStoExit) = 0 then FindColorsSpiralTolerance(x, y, tpaStoExit, 2893615, 433, 343, 555, 479, 10);
ATPA := TPAToATPAEx(tpaStoExit, 10, 10);
SortATPASize(ATPA, True);
MMouse(ATPA[0][0].x,ATPA[0][0].y,2,2);
Wait(1000 + random(200));
Mouse(ATPA[0][0].x,ATPA[0][0].y,2,2, True);
repeat
wait(100)
until (Full = true) or (CheckHarving = true);
end;
procedure GotoCoal;
begin
Wait(1000 + random(500));
CheckCoalCaveMap;
Wait(1000 + random(500));
MapWalkCoal;
while not (ArriveAtCoal) do
wait(500 + random(200));
PressTab;
Wait(1000 + random(500));
SearchCoal;
end;
procedure MapWalkExit;
begin
//AddToReport('DBInf - proc MapWalkCoal')
if FindDTM(dtmCaveExitMap, x, y, 0, 0, Width, Height) then
begin
MMouse(x, y, 1, 1)
Wait(1000 + random(100))
Mouse(x, y, 0, 0, True)
end
else
WriteLn('WS Coal Cave on map not found!');
end;
function ArriveAtCaveExit:Boolean;
begin
//AddToReport('DBInf - func ArriveAtCoal')
result := false;
if FindDTM(dtmArriveCaveExitMap, x, y, 0, 0, Width, Height) then
result := true
else
result := false;
Wait(1000 + random(500));
end;
procedure SearchExit;
begin
//AddToReport('DBInf - proc SearchExit')
FindColorsSpiralTolerance(x, y, tpaStoExit, 921102, 417, 302, 529, 352, 10);
if Length(tpaStoExit) = 0 then FindColorsSpiralTolerance(x, y, tpaStoExit, 2566442, 417, 302, 529, 352, 10);
ATPA := TPAToATPAEx(tpaStoExit, 10, 10);
SortATPASize(ATPA, True);
MMouse(ATPA[0][0].x,ATPA[0][0].y,2,2);
Wait(1000 + random(200));
Mouse(ATPA[0][0].x,ATPA[0][0].y,2,2, True);
Wait(1500 + random(500));
end;
procedure GotoExit;
begin
Wait(500 + random(500));
LookNorthFromEast;
Wait(200);
LookNorthFromEast;
Wait(200);
CheckCoalCaveMap;
Wait(1000 + random(500));
MapWalkExit;
while not (ArriveAtCaveExit) do
wait(500 + random(200));
PressTab;
Wait(1000 + random(500));
SearchExit;
end;
procedure MapWalkNExit;
begin
//AddToReport('DBInf - proc MapWalkNExit')
if FindDTM(dtmNExitMap, x, y, 0, 0, Width, Height) then
begin
MMouse(x, y, 1, 1)
Wait(1000 + random(100))
Mouse(x, y, 0, 0, True)
end
else
WriteLn('Nordcarn Exit on map not found!');
end;
function ArriveAtNExit:Boolean;
begin
//AddToReport('DBInf - func ArriveAtNExit')
result := false;
if FindDTM(dtmArriveNExitMap, x, y, 0, 0, Width, Height) then
result := true
else
result := false;
Wait(1000 + random(500));
end;
procedure ClickNExit;
begin
//AddToReport('DBInf - proc ClickNExit')
FindColorsSpiralTolerance(x, y, tpaStoExit, 6509390, 267, 350, 358, 427, 10);
if Length(tpaStoExit) = 0 then FindColorsSpiralTolerance(x, y, tpaStoExit, 6509390, 267, 350, 358, 427, 10);
ATPA := TPAToATPAEx(tpaStoExit, 10, 10);
SortATPASize(ATPA, True);
MMouse(ATPA[0][0].x,ATPA[0][0].y,2,2);
Wait(1000 + random(200));
Mouse(ATPA[0][0].x,ATPA[0][0].y,2,2, True);
Wait(1500 + random(500));
end;
procedure GotoNordcarnExit;
begin
Wait(1000 + random(500));
CheckWSMap;
Wait(1000 + random(500));
MapWalkNExit;
while not (ArriveAtNExit) do
wait(500 + random(200));
PressTab;
Wait(1000 + random(500));
ClickNExit;
end;
procedure MapWalkNSto;
begin
//AddToReport('DBInf - proc MapWalkNSto')
if FindDTM(dtmNStoMap, x, y, 0, 0, Width, Height) then
begin
MMouse(x, y, 1, 1)
Wait(1000 + random(100))
Mouse(x, y, 0, 0, True)
end
else
WriteLn('Nordcarn Storage on map not found!');
end;
function ArriveAtNSto:Boolean;
begin
//AddToReport('DBInf - func ArriveAtNSto')
result := false;
if FindDTM(dtmArriveNStoMap, x, y, 0, 0, Width, Height) then
result := true
else
result := false;
Wait(1000 + random(500));
end;
procedure EnterSto;
begin
//AddToReport('DBInf - proc EnterSto')
FindColorsSpiralTolerance(x, y, tpaStoExit, 1781062 , 467, 213, 607, 322, 10);
if Length(tpaStoExit) = 0 then FindColorsSpiralTolerance(x, y, tpaStoExit, 923686 , 467, 213, 607, 322, 10);
ATPA := TPAToATPAEx(tpaStoExit, 10, 10);
SortATPASize(ATPA, True);
MMouse(ATPA[0][0].x,ATPA[0][0].y,2,2);
Wait(1000 + random(200));
Mouse(ATPA[0][0].x,ATPA[0][0].y,2,2, True);
Wait(1500 + random(500));
end;
procedure GotoNSto;
begin
Wait(1000 + random(500));
CheckNordcarnMap;
Wait(1000 + random(500));
MapWalkNSto;
while not (ArriveAtNSto) do
wait(500 + random(200));
PressTab;
Wait(1000 + random(500));
EnterSto;
end;
procedure MapWalkStoril;
var
dtmStorilMap : integer;
begin
//AddToReport('DBInf - proc MapWalkStoril')
dtmStorilMap := DTMFromstring('78DA63BCC9C4C010CE80023A93F5C0342394C' +
'FB80FA8C61F554D9D1937AA9AB74035AEA86A440AB551D5DC02AA' +
'C94455736B9716AA9AEF403561A86AFEFFFF8FA2060041BC0D58');
if FindDTM(dtmStorilMap, x, y, 0, 0, Width, Height) then
begin
MMouse(x, y, 1, 1)
Wait(1000 + random(100))
Mouse(x, y, 0, 0, True)
end
else
WriteLn('Storil not found!');
FreeDTM(dtmStorilMap);
end;
function ArriveAtStoril2: boolean;
begin
result := False;
if FindColorSpiralTolerance(x, y, PlayerMap, 721, 82, 735, 93, 10) then
begin
result := True;
end
else
result := False;
end;
procedure FindStorilTPA;
begin
//AddToReport('DBInf - proc FindStorilTPA')
FindColorsSpiralTolerance(x, y, tpaStoril, 2430483, 378, 361,554, 480, 10);
if Length(tpaStoril) = 0 then
FindColorsSpiralTolerance(x, y, tpaStoril, 2955799, 165, 29, 955, 714, 10);
ATPA := TPAToATPAEx(tpaStoril, 10, 10);
SortATPASize(ATPA, True);
MMouse(ATPA[0][0].x,ATPA[0][0].y,2,2);
Wait(1000 + random(500));
Mouse(ATPA[0][0].x,ATPA[0][0].y,2,2, True);
end;
procedure OpenSto;
var
OpenStoDTM : integer;
begin
//AddToReport('DBInf - proc OpenSto')
OpenStoDTM := DTMFromstring('78DA631466606058C380023E7F86D08C503EA' +
'32890D882AA262A0A4D0D1790C8425563E9A989AAC61A48AC4455' +
'337122AA390052F90750');
if FindDTM(OpenStoDTM, x, y, 0, 0, Width, Height) then
begin
Wait(1500 + random(100))
MMouse(x, y, 0, 0)
Wait(500 + random(50))
Mouse(x, y, 0, 0, True)
end;
Wait(200 + random(50));
FreeDTM(OpenStoDTM);
end;
procedure FindStoAll;
var
bmpStoAll : integer;
begin
//AddToReport('DBInf - proc FindStoAll')
bmpStoAll := LoadBitmap('.\EL\StoAll.bmp');
if FindBitmapTolerance(bmpStoAll, x, y, 100) then
begin
MMouse(x,y,0,0)
Mouse(x, y, 10, 10, True);
end
else
begin
WriteLn('Bitmap not found')
end;
end;
procedure CloseDialogs;
begin
Mouse(936, 368, 10, 10, True);
Mouse(385, 192, 10, 10, True);
Mouse(623, 49, 10, 10, True);
end;
procedure GotoStoril;
begin
//AddToReport('DBInf - proc GotoStoril')
wait(1000 + random(500));
CheckStoMap;
MapWalkStoril;
while not ArriveAtStoril2 do
wait(1000 + random(200));
PressTab;
FindStorilTPA;
Wait(1000 + random(300));
OpenSto;
Wait(1500 + random(500));
FindStoAll;
CloseDialogs;
Loads := Loads + 1;
end;
function CheckHarving:Boolean;
var
y, EmuStart, Emuend, EmuX : integer;
//EMUBar Full = 4408182
begin
//AddToReport('DBInf - func CheckHarving')
result := False
EmuStart := 447;
Emuend := 545;
y := 726;
EmuX := EmuStart
repeat
begin
EmuX := EmuX + 1
end
until (GetColor(EmuX, y) <> 4408182);
Wait(15000);
if (LastX = EmuX) then
begin
// WriteLn('not harvest since last time:(')
LastX := EmuX
LastX2 := EmuX
result := True
HarvEvents := HarvEvents + 1
// PressTab
Wait(1000)
if CheckPickAxe then
GotoCoal
else
begin
GotoExit
GotoNordcarnExit
GotoNSto
end;
end
else
begin
LastX := EmuX
LastX2 := EmuX
end;
exit;
end;
procedure Proggie;
begin
//AddToReport('DBInf - proc Proggie')
Text := '';
X := 148 - Length(TheDate(1));
for I := 1 to X do
Insert(chr(32), Text, Length(Text));
Writeln(Text + '.');
Writeln(Text + '.');
WriteLn(' _Progress Report_________________________________ ');
WriteLn('/ \');
WriteLn('| ' + Title+' |');
WriteLn('|_________________________________________________|');
WriteLn('| | |');
WriteLn('| Time Running | ' + TimeRunning);
WriteLn('| Mining Events | ' + IntToStr(HarvEvents));
WriteLn('| Loads Done | ' + IntToStr(Loads));
WriteLn('|________________|________________________________|');
WriteLn('| |');
WriteLn('| Version '+Version + ' |');
WriteLn('|_________________________________________________|');
Text := '';
Writeln(Text + '.');
UDLFile := OpenFile(ScriptPath + 'WSCoalMiner.txt', False);
ReadFileString(UDLFile, Text, FileSize(UDLFile));
CloseFile(UDLFile);
UDLFile := RewriteFile(ScriptPath + 'WSCoalMiner.txt', False);
Delete(Text, LastPos(TheDate(1), Text) + Length(TheDate(1)) + Length(TheTime) + 3, Length(Text));
DebugText := GetDebugText;
DebugText := Copy(DebugText, LastPos('_Prog', DebugText) - X - 46, Length(DebugText));
Insert(DebugText, Text, Length(Text));
WriteFileString(UDLFile, Text);
CloseFile(UDLFile);
end;
procedure MainLoop;
begin
LoadDTMs;
ExitSto;
GotoWSExit;
GotoCave;
GotoCoal;
GotoExit;
GotoNordcarnExit;
GotoNSto;
GotoStoril;
FreeDTMs;
end;
begin
ClearDebug;
ClearReport;
SetupSRL;
ActivateClient;
GetClientDimensions(Width, Height);
Disguise(Title + ' - ' + Version);
Writeln('Progress Reports saved to ' + ScriptPath + 'WSCoalMiner.txt');
Text := '';
if (FileExists(ScriptPath + 'WSCoalMiner.txt')) then
begin
UDLFile := OpenFile(ScriptPath + 'WSCoalMiner.txt', False);
ReadFileString(UDLFile, Text, FileSize(UDLFile));
CloseFile(UDLFile);
end;
UDLFile := RewriteFile(ScriptPath + 'WSCoalMiner.txt', False);
if (Text <> '') then
WriteFileString(UDLFile, Text);
WriteFileString(UDLFile, TheDate(1) + ', ' + TheTime + ' ');
CloseFile(UDLFile);
MainLoop;
Proggie;
end.