Код: Выделить всё
Program AutoLumber;
{$Include 'all.inc'}
const
Xmin = 1552; //tyt zadaem quadrat uchastka, rde craft rubit logi
Xmax = 1578;
Ymin = 1646;
Ymax = 1639;
Trap = $4340422D ; // ID trap lodki
vozleX = 1532; // NEAR BOARD
vozleY = 1657;
lodkaX = 1526; // ONBOARD
lodkaY = 1658;
resX = 1472; // koord resalki
resY = 1611;
rb = $0EFA;
kompas = 2; // ??????????? ?????? ? ????? ?? ????? - 0 ??? 2 ??? 4 ??? 6
//6////0
////X - eto craft na lodke 'X', numbers - eto napravlenie 6 ili 0 ili 4 ili 2
//4////2
CopperType = $1BF2;
IngotColor = $07DF;
MyMaxWeight = 175; // MAX WES - kak naberet - idet na lodku
AxeType = $0F43;
AxeGump = '3907';
eda = $097B;
maxfood = 10;
iTTileCount = 183;
Msg1 = 'not enough';
Msg2 = 'broke';
Msg3 = 'far away|mine here|how to use those';
Msg4 = 'no more';
LogType = $1BDD;
DeadWoods = $0F90;
Tinktype = $1EB9;
TinkGump = '7865';
type
ChopTile = Record
x, y : Integer;
end;
var
FoundTilesArray : TFoundTilesArray;
TempFoundTilesArray, ChopTilesArray : array of TFoundTile;
TreeTile:array [0..iTTileCount] of word;
ctime : TDateTime;
i : Integer;
ETimer : Cardinal;
Procedure Eat;
Begin
If (GetTickCount > ETimer + (5 * 60 * 1000)) Then Begin
Hungry(1, -1);
ETimer := GetTickCount;
End;
End;
procedure checkcoord;
begin
CheckLag (30000);
if (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) = 0 then
begin
repeat
UseObject(Trap);
CheckLag (30000);
wait(1000);
Raw_Move(kompas, True);
CheckLag (30000);
wait(500);
Raw_Move(kompas, True);
CheckLag (30000);
wait(500);
until (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) > 0;
end;
end;
procedure checkfish;
var food: integer;
Begin
if (count(eda) < maxfood) then
begin
repeat
food:=count (eda);
CheckLag (30000);
FindType(eda,ground);
if FindQuantity = 0 then continue;
if (FindQuantity > (maxfood-food)) then
begin
grab (finditem, maxfood-food);
end
else grab (finditem, 0);
CheckLag (30000);
wait (1000);
AddToSystemJournal('Food left: '+inttostr(count ($097B)-food));
until (countground($097B)=0) or (count($097B)>(maxfood-1));
end;
end;
procedure CheckAxe;
var food: integer;
Begin
if (count($097B)<maxfood) then
repeat
food:=count ($097B);
WaitConnection(3000);
CheckSave;
FindType($097B,ground);
if finditem=0 then continue;
if (findquantity>(maxfood-food)) then grab (finditem, maxfood-food) else grab (finditem, 0);
wait (500);
//AddToSystemJournal('Food left '+inttostr(count ($097B))+' food');
until (countground($097B)=0) or (count($097B)>maxfood-1);
if (Count(AxeType) < 2) then
begin
begin
FindType(Tinktype,ground);
if FindCount < 2 then
begin
UseObject(FindType(Tinktype,ground));
WaitTargetobject(findtypeEX(CopperType,IngotColor,ground,false));
WaitGump(TinkGump)
wait(100);
WaitJournalLine(Now, 'You create|make|destroy|You put', 12000);
Drophere(FindType(TinkType,backpack));
wait(200);
end
else
begin
repeat
WaitConnection(3000);
CheckSave;
checkdead;
findtypeEX(CopperType,IngotColor,ground, false);
if FindCount > 0 then
begin
UseObject(FindType(TinkType,ground));
WaitTargetobject(findtypeEX(CopperType,IngotColor,ground, false));
WaitGump(AxeGump);
wait(150);
WaitJournalLine(Now, 'You create|make|destroy|You put', 12000);
end
else
begin
AddToSystemJournal('nema coopera!');
FullDisconnect;
end;
until Count(AxeType) >= 2
end
end
end
End;
procedure InitTTilesArray;
begin
TreeTile[0] := 3299
TreeTile[1] := 3293
TreeTile[2] := 3278
TreeTile[3] := 3294
TreeTile[4] := 3286
TreeTile[5] := 3278
TreeTile[6] := 3293
TreeTile[7] := 3283
TreeTile[8] := 3277
TreeTile[9] := 3289
TreeTile[10] := 3303
TreeTile[11] := 3297
TreeTile[12] := 3300
TreeTile[13] := 3291
TreeTile[14] := 3305
T
end;
procedure InitSystem;
begin
SetArrayLength(ChopTilesArray, 1);
end;
// ????? ????????
procedure SearchTree;
var
i, j : Integer;
iFoundTilesArrayCount : word;
iTempFoundTilesArrayCount : Integer;
begin
for i:= 0 to iTTileCount do
begin
iFoundTilesArrayCount := GetStaticTilesArray(Xmin, Ymin, Xmax, Ymax, 0, TreeTile[i], FoundTilesArray);
if iFoundTilesArrayCount > 0 then
begin
SetArrayLength(TempFoundTilesArray, Length(TempFoundTilesArray) + iFoundTilesArrayCount);
for j := 0 to iFoundTilesArrayCount - 1 do
begin
TempFoundTilesArray[iTempFoundTilesArrayCount + j] := FoundTilesArray[j];
end;
iTempFoundTilesArrayCount := iTempFoundTilesArrayCount + iFoundTilesArrayCount;
end;
end;
AddToSystemJournal('iTempFoundTilesArrayCount: ' + IntToStr(iTempFoundTilesArrayCount));
end;
// ?????? ?????? ????????? (Vizit0r :P)
procedure ClearDuplicate;
var
i, j : Integer;
begin
ChopTilesArray[Length(ChopTilesArray) - 1] := TempFoundTilesArray[0];
for i:=1 to Length(TempFoundTilesArray) - 1 do
begin
for j:=0 to Length(ChopTilesArray) - 1 do
if (ChopTilesArray[j] = TempFoundTilesArray[i]) then
break;
if j > Length(ChopTilesArray) - 1 then
begin
SetArrayLength(ChopTilesArray, Length(ChopTilesArray) + 1);
ChopTilesArray[Length(ChopTilesArray) - 1] := TempFoundTilesArray[i];
end;
end;
AddToSystemJournal('ClearDuplicate:' + IntToStr(Length(ChopTilesArray)));
end;
// ???????? ? ??????? 2 (Shinma)
function sqr(a:LongInt):LongInt;
begin
result:=a*a;
end;
// ????????? ????? ??????? (Shinma)
function vector_length(c_2:TFoundTile):LongInt;
begin
result:=Round(sqrt(sqr(GetX(self)-c_2.X)+sqr(GetY(self)-c_2.Y)));
end;
procedure QuickSort(A: array of TFoundTile; l,r: integer);
var
i, j: Integer;
x, y: TFoundTile;
begin
i := l;
j := r;
x := A[((l + r) div 2)];
repeat
while vector_length(A[i]) < vector_length(x) do inc(i);
while vector_length(x) < vector_length(A[j]) do dec(j);
if not (i>j) then
begin
y:= A[i];
A[i]:= A[j];
A[j]:= y;
inc(i);
dec(j);
end;
until i>j;
if l < j then QuickSort(ChopTilesArray, l,j);
if i < r then QuickSort(ChopTilesArray, i,r);
end;
procedure MarkTrees;
begin
SearchTree;
AddToSystemJournal('MarkTrees: ' + IntToStr(Length(TempFoundTilesArray)));
ClearDuplicate;
QuickSort(ChopTilesArray, 0, Length(ChopTilesArray) - 1);
end;
// ?????????
procedure DropLog;
var g : integer;
LogCol : Array [0..20] of Word;
Begin
finddistance := 2;
CheckLag (30000);
AddToSystemJournal('DropLog');
LogCol[0] := $0000; // Log
LogCol[1] := $0362; // Jade
LogCol[2] := $010D; // Oak
LogCol[3] := $0094; // Karund
LogCol[4] := $01B0; // Leshram
LogCol[5] := $01A2; // Tourmalite
LogCol[6] := $0026; // Emerint
LogCol[7] := $00CB; // Legrand
LogCol[8] := $094A; // Solmur
LogCol[9] := $092B; // Kleor
LogCol[10] := $0931; // Logradoom
LogCol[11] := $093F; // Vialonit
LogCol[12] := $0074; // Stardust
LogCol[13] := $006F; // Pyronil
LogCol[14] := $09EF; // Mystic
LogCol[15] := $0119; // Elvin
LogCol[16] := $000B; // Elkris
for g := 0 to 16 do
begin
CheckLag (30000);
FindTypeEx(LogType,LogCol[g],backpack,false);
if FindCount > 0 then
begin
stack(LogType,LogCol[g]);
CheckLag (30000);
wait(1000);
end;
end;
FindTypeEx(DeadWoods,$ffff,backpack,false);
if FindCount > 0 then
begin
stack(DeadWoods,$ffff);
CheckLag (30000);
wait(1000);
end;
hungry (1,-1);
wait(500);
Addtosystemjournal('=========================================');
FindType(LogType,ground);
Addtosystemjournal('total logs - '+intToStr(findfullquantity));
FindTypeEx(LogType,$0000,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Log - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$0362,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Jade - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$010D,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Oak - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$0094,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Karund - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$01B0,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Leshram - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$01A2,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Tourmalite - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$0026,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Emerint - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$00CB,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Legrand - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$094A,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Solmur - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$092B,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Kleor - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$0931,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Logradoom - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$093F,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Vialonit - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$0074,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Stardust - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$006F,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Pyronil - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$09EF,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Mystic - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$0119,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Elvin - '+intToStr(findfullquantity));
end;
FindTypeEx(LogType,$000B,ground,False);
if FindCount > 0 then
begin
Addtosystemjournal('Elkris - '+intToStr(findfullquantity));
end;
FindType(CopperType,ground);
Addtosystemjournal('Copper-ingots: ' + intToStr(findfullquantity));
FindType(eda,ground);
Addtosystemjournal('Fish-steaks: ' + intToStr(findfullquantity));
Addtosystemjournal('=========================================');
End;
procedure resself;
begin
AddToSystemJournal('Resself. Enter');
WaitConnection(3000);
checksave;
Wait(1000);
WaitGump('1');
setwarmode(true);
while dead do wait(1000);
if findtype($2006,ground) > 0 then begin
if targetpresent then canceltarget;
waittargetobject(finditem);
useobject(findtype($0F51,ground));wait(1000);
end;
hungry(1,ground);
Wait(30000);
UOSay('Thx');
AddToSystemJournal('Resself. Exit');
end;
// GotoOnBoad
procedure GotoOnBoad;
begin
if (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) > 0 then
begin
repeat
CheckLag (30000);
NewMoveXY(vozleX,vozleY, True, 0, True);
CheckLag (30000);
wait(1000);
until (Dist(GetX(Self), GetY(Self), vozleX, vozleY)) = 0;
if (Dead) then
begin
repeat
CheckLag (30000);
NewMoveXY(resX,resY, True, 0, True);
CheckLag (30000);
wait(500);
WaitGump('1');
until (Dist(GetX(Self), GetY(Self), resX, resY)) = 0;
while dead do resself;
repeat
CheckLag (30000);
SetWarMode(false);
NewMoveXY(vozleX,vozleY, True, 0, True);
CheckLag (30000);
wait(1000);
until (Dist(GetX(Self), GetY(Self), vozleX, vozleY)) = 0;
end;
repeat
UseObject(Trap);
CheckLag (30000);
wait(1000);
UseObject(Trap);
CheckLag (30000);
NewMoveXY(lodkaX,lodkaY, True, 0, True);
CheckLag (30000);
wait(1000);
until (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) = 0;
end;
if (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) = 0 then
begin
CheckDead;
Hungry(1,ground);
DropLog;
CheckAxe;
checkfish;
checkcoord;
end;
end;
procedure CheckEquip;
Var EquipAxe : Cardinal;
begin
if (GetType(ObjAtLayer(LhandLayer)) <> AxeType) then
begin
Disarm;
CheckLag (30000);
wait(500);
FindType(AxeType, Backpack);
if (FindCount > 0) then
begin
EquipAxe := finditem;
Equip(LhandLayer, EquipAxe);
CheckLag (30000);
wait(500);
end
else GotoOnBoad;
end;
end;
procedure BrosaemMusor;
var t : integer;
Cvet : Array [0..7] of Word;
Begin
finddistance := 2;
CheckLag (30000);
// AddToSystemJournal('Sbrasivaem musor!');
Cvet[0] := $0000; // Log
Cvet[1] := $0362; // Jade
Cvet[2] := $010D; // Oak
Cvet[3] := $0094; // Karund
Cvet[4] := $01B0; // Leshram
Cvet[5] := $01A2; // Tourmalite
Cvet[6] := $0026; // Emerint
Cvet[7] := $00CB; // Legrand
for t := 0 to 7 do
begin
CheckLag (30000);
FindTypeEx(LogType,Cvet[t],backpack,false);
if FindCount > 0 then
begin
CheckLag(30000);
MoveItem(finditem, 0, ground, 0, 0, 0);
wait(300);
end;
end;
CheckEquip;
end;
function LumbCurTree(tile,x,y,z : Integer) : Boolean;
var
q, m1, m2, m3, m4, NextTree : integer;
begin
Result := true;
repeat
Eat;
CheckLag (30000);
If TargetPresent Then CancelTarget;
if (GetType(ObjAtLayer(LhandLayer)) = AxeType) then
CheckEquip;
if WarMode = true then SetWarMode(false);
if TargetPresent then CancelTarget;
ctime := Now;
CheckLag (30000);
CheckEquip;
wait(500);
CheckLag (30000);
WaitTargetTile(tile, x, y, z);
UseObject(ObjAtLayer(LhandLayer));
CheckLag (30000);
q := 0;
repeat
wait(100);
q := q + 1;
checksave;
m1 := InJournalBetweenTimes(Msg1, ctime, Now);
m2 := InJournalBetweenTimes(Msg2, ctime, Now);
m3 := InJournalBetweenTimes(Msg3, ctime, Now);
m4 := InJournalBetweenTimes(Msg4, ctime, Now);
until (m1<>-1) or (m2<>-1) or (m3<>-1) or (m4<>-1) or Dead or (q > 450);
BrosaemMusor;
if Dead or (Weight > MyMaxWeight) then
begin
Result := false;
exit;
end;
if (q > 200) then NextTree := NextTree + 1;
until (m1<>-1) OR (m2<>-1) OR (m3<>-1) OR (m4<>-1)OR (NextTree > 3);
if NextTree >= 3 then NextTree := 0;
end;
// ??????? ???????
Begin
SetARStatus(True);
Addtosystemjournal('Begin.');
BrosaemMusor;
GotoOnBoad;
InitTTilesArray;
InitSystem;
MarkTrees;
while (not dead) and (connected) do
begin
for i:= 0 to Length(ChopTilesArray) - 1 do
begin
Disarm;
NewMoveXY(ChopTilesArray[i].x, ChopTilesArray[i].y, true, 1, true);
Addtosystemjournal('Tile Number: '+intToStr(i+1)+'.');
if not LumbCurTree(ChopTilesArray[i].tile, ChopTilesArray[i].x, ChopTilesArray[i].y, ChopTilesArray[i].z) then GotoOnBoad;
end;
end;
End.
[/code