Nava2
2011-01-16 20:10:00
http://code.google.com/p/nzmm/source/browse/trunk/MM.simba
Just for your use. :)
program New;
//{.include SRL/SRL/Misc/Smart.scar}
{.include SRL/SRL.scar}
{.include SRL/SRL/Misc/Debug.scar}
const
rockTypes = 0;
dropItems = 1;
item_Count = 4;
item_Ore = 0;
item_Clay = 1;
item_Gem = 2;
item_PickAxe = 3;
item_unkwn = -2;
rock_Clay = 0;
rock_Copper = 1;
rock_Tin = 2;
rock_Iron = 3;
procedure DeclarePlayers;
begin
HowManyPlayers := 1;
NumberOfPlayers(HowManyPlayers);
with Players[0] do
begin
Name := 'molotov 2005';
Pass := 'mimas';
Nick := 'olo';
Active := True;
Arrays[rockTypes] := [rock_Tin];
Arrays[dropItems] := [item_Ore];
end;
end;
const
Debug_All = True;
TextWait = 120;
{ Max wait time between mining ore starts and getting the ore. (Seconds) }
maxOreWait = 30;
rockWidth = 30;
rockHeight = 30;
rockMinCount = 30;
rockMaxCount = 140;
mineUpText = 'ine Rocks';
mineRandomClickChance = 7;
mineOption = 'ine Rocks';
item_color = 0;
item_dtm = 1;
item_bitmap = 2;
item_bitmapmask = 3;
gemUpText = 'ncut';
gemTypeBeginning = 'Uncut ';
gemTypeEnd = ' /';
type
TItemIdent = record
IdentType, Ident: Integer;
Tols: TIntegerArray;
end;
var
rockAutoColors, newRockAutoColors: array of TAutoColorInfo;
newSetupRocks: array of Boolean;
gbl_RockCols: T2DIntegerArray;
rockBounds: TBox;
itemRefs: array of TItemIdent;
itemAmounts: TIntegerArray;
mineSearchArea: TBox;
gemNames: TStringArray;
gemCounts: TIntegerArray;
{
procedure ChangeMeToUpdate;
One of the main reasons for the structure of this script is the ease of update
associated with it. This procedure needs to be changed if colors update, or
if the user just would like to add more colours for accuracy! Or maybe want to
add a different rock to mine/drop! *cough* granite *cough* All vars are
commented thoroughly and have descriptive constants associated.
}
procedure ChangeMeToUpdate;
begin
{ Search area for mineRock function. }
mineSearchArea := IntToBox(MSX1, MSY2, MSX2, MSY2);
{
To update colors, replace these arrays with new values. Script will do the
the rest of the fixing. Also, colours may want to be added for accuracy.
Speed drop will be relatively insignificant.
}
gbl_RockCols :=
[
// rock_Clay
TIntegerArray([7646926, 7712720, 5273742, 6987452, 6196390, 4944005, 5669273,
6065061, 5866911, 4026765, 5676999, 5676485, 5280696]),
// rock_Copper
TIntegerArray([4550042, 3692670, 3626876, 4418199, 2769759, 2703965, 3956873,
4220305, 3495032, 4022667, 4154769, 3957132, 4418716]),
// rock_Tin
TIntegerArray([8092545, 7698043, 8421766, 9869214, 10000543, 9540248,
10329508, 10066336, 9276819, 9145490, 8618889, 9737370,
7171442]),
// rock_Iron
TIntegerArray([2963024, 2831437, 2304575, 1909556, 2502212, 2568006, 2897231,
2370368, 2765644, 2765645, 3029076, 2963025, 2699851])
];
{
All the Item identifiers. These are items that the script recognizes and
will use.
Users: If you want to add an item, feel free to, and just add it into the
drop array etc. Might require some more changes as well.
}
setLength(itemRefs, item_Count);
setLength(itemAmounts, item_Count);
itemRefs[item_Ore].IdentType := item_DTM;
itemRefs[item_Ore].Ident :=
DTMFromString('78DA63D4636660E862644006168A920CFF813' +
'448F43F10305A00D54C4055C3C0C0C4C00C5503028C7244A8D106' +
'F2A61350630DE475106157177E350020060A06');
itemRefs[item_Ore].Tols := [];
itemRefs[item_Clay].IdentType := item_dtm;
itemRefs[item_Clay].Ident :=
DTMFromString('78DA63D4616660D8C8C8800CBA4BFD1878803' +
'448F43F10301A03D5AC4355C3C0C0C4C00C5503028C5A40DE1602' +
'6A5480BC0D04D46802796B08A831C47433BA1A006E140ABB');
itemRefs[item_Clay].Tols := [];
itemRefs[item_Gem].IdentType := item_dtm;
itemRefs[item_Gem].Ident :=
DTMFromString('78DA63FCC0CCC0309F9101194CECEA62F80FA' +
'441A2FF8180F131A61A0606260616A81A1060FC0E54B38008354B' +
'09A8790B54B38A809A2740354B08A8F90454331DBF1A00F54111D' +
'B');
itemRefs[item_Gem].Tols := [];
itemRefs[item_Pickaxe].IdentType := item_dtm;
itemRefs[item_PickAxe].Ident :=
DTMFromString('78DA63FCCFC4C0D0CDC8800CAC75A418FE036' +
'990E87F2060FC0654D388AA868181898119AA06041841E6B41150' +
'C304E4B51350C305E4351350F31768D764026A403C026A00A83E0' +
'D80');
itemRefs[item_PickAxe].Tols := [];
{ Names of the Gems that can be mined.. Plus Dragonstone.. you never know ;) }
gemNames := ['sapphire', 'emerald', 'ruby', 'diamond', 'dragonstone', 'opal',
'jade', 'red topaz'];
setLength(gemCounts, Length(gemNames));
end;
procedure n2_Debug(s: String);
var
ns: String;
begin
ns := MSToTime(GetTimeRunning, Time_Bare) + ' ' + s;
if (Debug_All = True) then
Writeln(ns);
Status(ns);
end;
{
procedure freezeClient;
Saves the client image to a bitmap. Allows the script to read from a static
bitmap rather than a changing client. Allows for more accurate AutoColoring.
theClientHandle *must* be initiated prior to this procedure being called.
Otherwise, the handle will be lost and must be found another way.
}
var
theClientHandle: HDC;
clientBMP: Integer;
procedure freezeClient;
var
w, h: Integer;
begin
getClientDimensions(w, h);
clientBMP := BitmapFromString(w, h, '');
CopyClientToBitmap(clientBMP, 0, 0, w, h);
SetTargetBitmap(clientBMP);
end;
{
procedure unfreezeClient;
Restores the client handle to the original client, rather than the bitmap.
Frees the stored bitmap.
}
procedure unfreezeClient;
begin
SetTargetDc(theClientHandle);
FreeBitmap(clientBMP);
end;
{
procedure setAutoColors;
Just a procedure to setup some arrays used in the script.
}
procedure setAutoColors;
var
i, hi: Integer;
begin
hi := Length(gbl_RockCols);
setLength(rockAutoColors, hi);
setLength(newRockAutoColors, hi);
setLength(newSetupRocks, hi);
dec(hi);
for i := 0 to hi do
rockAutoColors[i] := CreateAutoColorInfo(gbl_RockCols[i]);
end;
{
procedure getRockColors(rock: Integer);
Create a new TAutoColorInfo based off of the colours collected in teh script.
This new TAutoColor will be exactly what is found on the MS for the current
player. Called per player.
}
const
colorLeng = 4;
colorMaxWidth = 50;
colorMaxHeight = 50;
colorMaxPercent = 0.40;
colorMinPercent = 0.20;
procedure getRockColors(rock: Integer);
var
i, hi, j, hi2, w, h, k: Integer;
aC: TAutoColorInfo;
pts: TPointArray;
sTPA: T2DPointArray;
cols, newCols: TIntegerArray;
R, G, B: Integer;
X, Y, Z: Extended;
tb: TBox;
d: Extended;
begin
aC := rockAutoColors[rock];
ColorToleranceSpeed(2);
with aC do
begin
freezeClient;
setColorSpeed2Modifiers(hueMod, satMod);
FindColorsTolerance(pts, Color, MSX1, MSY1, MSX2, MSY2, lumTol);
DebugTPA(pts, '');
sTPA := SplitTPA(pts, colorLeng);
hi2 := High(sTPA);
for j := 0 to hi2 do
begin
tb := getTPABounds(sTPA[j]);
w := tb.x2 - tb.x1 + 1;
h := tb.y2 - tb.y1 + 1;
if (w > colorMaxWidth) and (h > colorMaxHeight) then
Continue;
d := (Length(sTPA[j]) / (w * h));
//n2_Debug(FloatToStr(d) + ' density');
if (d = 1) or ((d > colorMaxPercent) and (d < colorMinPercent)) then
Continue;
cols := getColors(sTPA[j]);
ClearSameIntegers(cols);
{ Eliminate any colours that don't match the specific criteria. }
hi := High(cols);
SetLength(newCols, k + hi + 1);
for i := 0 to hi do
begin
ColorToRGB(cols[i], R, G, B);
if (R >= MinR) and (R <= MaxR) and (G >= MinG) and (G <= MaxG) and
(B >= MinB) and (B <= MaxB) then
begin
ColorToXYZ(cols[i], X, Y, Z);
if (X >= MinX) and (X <= MaxX) and (Y >= MinY) and (Y <= MaxX) and
(Z >= MinZ) and (Z <= MaxZ) then
begin
newCols[k] := cols[i];
inc(k);
end;
end;
end;
end;
end;
setLength(newCols, k);
ClearSameIntegers(newCols);
unfreezeClient;
{
Create the new TAutoColorInfo with the newly found colours. *Should* have a
much smaller tolerance associated with the colours, as well as being more
accurate/faster.
}
DebugColorArray(newCols);
newRockAutoColors[rock] := CreateAutoColorInfo(newCols);
newSetupRocks[rock] := True;
with newRockAutoColors[rock] do
begin
setColorSpeed2Modifiers(hueMod, satMod);
ColorToleranceSpeed(2);
FindColorsTolerance(pts, Color, MSX1, MSY1, MSX2, MSY2, lumTol);
end;
DebugTPA(pts, '');
end;
{
function mineRock(var rX, rY: Integer; theRockType: Integer): Boolean;
Mines the closest rock found inside the mineSearchArea. It will try and find
all the rocks placed into the mineArr, finding the closest one.
}
function mineRock(var rX, rY: Integer; theRockType: Integer): Boolean;
var
rockI, rockLen, rockInd: Integer;
i, hi, c, j, k: Integer;
pts, rockPts: TPointArray;
sTPA: T2DPointArray;
begin
Result := False;
if not LoggedIn then Exit;
c := 0;
rockLen := High(Players[CurrentPlayer].Arrays[rockTypes]);
for rockI := 0 to rockLen do
begin
rockInd := Players[CurrentPlayer].Arrays[rockTypes][rockI]
{ Make sure the current rock Colour info is set up. }
if not newSetupRocks[rockInd] then
getRockColors(rockInd);
with newRockAutoColors[rockInd] do
begin
setColorSpeed2Modifiers(hueMod, satMod);
ColorToleranceSpeed(2);
FindColorsTolerance(pts, Color, MSX1, MSY1, MSX2, MSY2, lumTol);
end;
{ Create an ATPA of the individual rocks. }
sTPA := TPAToATPAEx(pts, rockWidth, rockHeight);
DebugATPA(sTPA, '');
hi := High(sTPA);
setLength(rockPts, c + hi + 1);
for i := 0 to hi do
begin
//n2_Debug(IntToStr(Length(sTPA[i])));
{ If the rocks are within the min and max count, add the middle point. }
if InRange(Length(sTPA[i]), rockMinCount, rockMaxCount) then
begin
rockPts[c] := MiddleTPA(sTPA[i]);
inc(c);
end;
end;
end;
{ Sort the new TPA of Suitable rocks by closest to the player. }
setLength(rockPts, c);
SortTPAFrom(rockPts, Point(MSCX, MSCY));
//DebugTPA(rockPts, '');
n2_Debug('Found ' + IntToStr(Length(rockPts)) + ' rocks.');
dec(c);
{ Cycle through the points, make sure the uptext is valid. Click! }
for i := 0 to c do
begin
MMouse(rockPts[i].x, rockPts[i].y, 4, 4);
if WaitUpText(mineUpText, TextWait) then
begin
//n2_Debug('Found: ' + getUpText);
getMousePos(rX, rY);
if (Random(mineRandomClickChance) = 0) then
begin
Mouse(rX, rY, 0, 0, False);
WaitOption(mineOption, TextWait);
end else
Mouse(rX, rY, 0, 0, True);
Result := True;
{
Create the bounds in which the rock will be found. This is used in
rockPresent.
}
j := rockWidth div 2;
k := rockHeight div 2;
rockBounds := IntToBox(rX - j, rY - k, rX + j, rY + k);
end;
Break;
end;
SetColorSpeed2Modifiers(0.2, 0.2);
end;
{
function rockPresent(theRockType: Integer): Boolean;
Checks for the presence of the rock in the rockBounds created in mineRock.
Uses the TAutoColorInfo for the rock type.
}
function rockPresent(theRockType: Integer): Boolean;
var
pts: TPointArray;
begin
Result := False;
if not LoggedIn then Exit;
with newRockAutoColors[theRockType] do
begin
setColorSpeed2Modifiers(hueMod, satMod);
ColorToleranceSpeed(2);
FindColorsTolerance(pts, Color, rockBounds.x1, rockBounds.y1,
rockBounds.x2, rockBounds.y2, lumTol);
end;
Result := (InRange(Length(Pts), rockMinCount, rockMaxCount));
setColorSpeed2Modifiers(0.2, 0.2);
end;
{
procedure WaitWhileMining(fx, fy, theRockType: Integer);
Waits while mining rock of type theRockType. It preforms several checks from
inventory, to object finding.
}
procedure WaitWhileMining(fx, fy, theRockType: Integer);
var
sOreCount, itemInd, timeOut: Integer;
begin
if (theRockType = rock_Clay) then
itemInd := item_Clay
else
itemInd := item_Ore;
{
Get and initial ore count, while the count is the same and the rock is still
found on the mainscreen, wait antiban etc. Has a timeout as a last measure.
}
timeOut := getTimeRunning + (maxOreWait * 1000);
sOreCount := CountItems('dtm', ItemRefs[itemInd].Ident, []);
while ((CountItems('dtm', ItemRefs[itemInd].Ident, []) = sOreCount) and
(rockPresent(theRockType)) and (timeOut > getTimeRunning)) do
begin
Wait(100 + Random(50));
end;
end;
{
function newFindItemMultiEx(var x, y: Integer; ItemArr: array of TItemIdent;
Area: TBox; var Which: Integer): Boolean;
Finds the first occurange from the ItemArr and returns the x, y coords
respectively. Also returns the index of the itemArr found.
}
function newFindItemMultiEx(var x, y: Integer; ItemArr: array of TItemIdent;
Area: TBox; var Which: Integer): Boolean;
var
Pts: TPointArray;
i, hi: Integer;
begin
Result := False;
hi := High(itemArr);
for i := 0 to hi do
begin
with itemArr[i] do
{ Dependant on what identType is passed, preform the necessary function. }
case IdentType of
item_bitmapmask:
begin
SetLength(Tols, 2);
Result := FindBitmapMaskTolerance(Ident, x, y, Area.x1, Area.y1,
Area.x2, Area.y2, Tols[0], Tols[1]);
end;
item_bitmap:
Result := FindTransparentBitmapTolerance(Ident, x, y, 0,
Area.x1, Area.y1,
Area.x2, Area.y2, Tols[0]);
item_dtm:
Result := FindDTM(Ident, x, y, Area.x1, Area.y1, Area.x2, Area.y2);
item_color:
begin
SetLength(Tols, 2);
FindColorsTolerance(Pts, Ident, Area.x1, Area.y1,
Area.x2, Area.y2, Tols[0]);
if Tols[1] < 1 then Tols[1] := 1;
Result := Length(Pts) >= Tols[1];
if Result then
MiddleTPAEx(Pts, x, y);
end;
else
SRL_Warn('FindItem', 'Invalid identifier ''' + IntToStr(IdentType)
+ ''' input as IdentType.', -1);
end;
if Result then
begin
Which := i;
Exit;
end;
end;
Which := -1;
end;
{
Returns the name of the gem at `slot'.
}
function getGemType(slot: Integer): Integer;
var
s: String;
i: Integer;
begin
MMouseItem(slot);
waitUpText(gemUpText, TextWait);
s := getUpText;
s := lowerCase(between(gemTypeBeginning, gemTypeEnd, s));
slot := High(gemNames);
for i := 0 to slot do
if (s = gemNames[i]) then
Break;
Result := i;
end;
var
invArr: TIntegerArray;
{
procedure invManagement;
Created to manage the inventory. Completes tasks such as dropping, organizing
and counting of items.
}
procedure invManagement;
var
i, j, fx, fy: Integer;
dropArr: TIntegerArray;
begin
if not LoggedIn then Exit;
n2_Debug('Initiating Inventory management.');
dropArr := Players[currentPlayer].Arrays[dropItems];
for i := 1 to 28 do
begin
{
if we have no record of the item, and the item exists, get what type of
item it is and increase the count per item.
}
if (invArr[i] = -1) and (existsItem(i)) then
begin
newFindItemMultiEx(fx, fy, itemRefs, InvBox(i), invArr[i]);
if (invArr[i] = -1) then
invArr[i] := item_unkwn;
if (invArr[i] = item_Gem) then
Inc(gemCounts[getGemType(i)])
else
if (invArr[i] <> item_unkwn) then
inc(itemAmounts[invArr[i]]);
end;
{ Check if the current item is part of the players dropping array. }
if InIntArray(dropArr, invArr[i]) then
begin
MouseItem(i, False);
waitOption('rop', TextWait);
inc(itemAmounts[invArr[i]]);
invArr[i] := -1;
end else
{
if the item is not to be dropped, and to be kept, lets put it at
the end of the inventory.
}
if InIntArray([item_Gem, item_PickAxe, item_unkwn], invArr[i])
and (not InvFull) then
begin
n2_Debug('Found an item to be kept, attempting to move the gem.');
for j := 28 to 1 do
if not InIntArray([item_Gem, item_PickAxe, item_unkwn], invArr[i]) then
begin
MMouseItem(i);
Wait(RandomRange(100, 200));
GetMousePos(fx, fy);
HoldMouse(fx, fy, True);
MMouseItem(j);
Wait(RandomRange(100, 200));
GetMousePos(fx, fy);
ReleaseMouse(fx, fy, True);
swap(invArr[i], invArr[j]);
Break;
end;
end;
end;
if (invFull) then
begin
LogOut;
n2_Debug('Player[' + IntToStr(CurrentPlayer) + '] is now inactive. ' +
'Inventory is full and cannot mine any more.');
n2_Debug('Perhaps, try adding more items into the Drop array, item_unkwn too');
Players[CurrentPlayer].Loc := 'Inventory is full.';
end;
end;
var
x, y, r: Integer;
begin
SetupSRL;
DeclarePlayers;
ChangeMeToUpdate;
GraphicsSet := True;
LoginPlayer;
theClientHandle := GetTargetDC;
setAutoColors;
mineRock(x, y, r);
end.Just for your use. :)