Code: Select all
Program LumberJacking;
type LumberR = record
tile:word;
px,py,pz:integer;
end;
Var LumberP: array [0..16] of LumberR;
a,d,e : byte;
ItemCount,b:Integer;
Const
eda = $097B;
nearX = 2730;
nearY = 2206;
onboadx = 2730;
onboady = 2201;
onboadz = -2;
Trap = $77882592;
maxweight = 350;
logType = $1BDD;
AxeType = $0F43;
AxeGump = '3907';
TinkGump = '7865';
Tinktype = $1EB9;
CopperType = $1BF2;
{$Include 'all.inc'}
procedure checkdead;
Begin
if Dead then
begin
AddToSystemJournal('×àð ìåðòâ. Âðåìÿ ñìåðòè: '+TimeToStr(now)+' (c)Äîêòîð Ôðàíêèíøòåéí');
FullDisconnect;
end
End;
Procedure GetLumberTiles(s:String;WPos:Integer);
begin
s := s + ' ';
LumberP[WPos].tile:=StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
LumberP[WPos].px:=StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
LumberP[WPos].py:=StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
LumberP[WPos].pz:=StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
end;
Procedure GetCoord;
var
List:TStringList;
b:integer;
begin
List:=TStringList.Create;
List.LoadFromFile('E:\Games\Uo\Stealth_v0.95bFull\Scripts\Demo\Ltiles.txt');
for b := 0 to List.Count-1 do
GetLumberTiles(List.strings[b],b);
ItemCount:=b;
end;
procedure hodilka(x,y,prec : integer; runflag : boolean);
// x,y - êîîðäèíàòû, â êîòîðûå èäåì
// prec - òî÷íîñòü ïîäõîäà
// runflag - áåæàòü èëè èäòè
// v. 1.04 (ñ) Edred, ñêðèïò ïîðòèðîâàí ñ èíæåêòà
// îðèãèíàëüíàÿ âåðñèÿ Yoko ñ äîðàáîòêîé AGRS è Edred.
var ld, ldc, dx, dy, mx, my : Integer;
begin
ld := 0; ldc := 0; d := 0; e := 2;
AddToSystemJournal('è òóò Îñòàïà ïîíåñëîîî');
while true do
begin
dx := GetX(self) - x; if dx < 0 then dx := 0 - dx;
dy := GetY(self) - y; if dy < 0 then dy := 0 - dy;
if dy > dx then dx := dy;
if dx <= prec then exit;
mx := GetX(self); my := GetY(self);
dx := mx - x; if dx < 0 then dx := 0 - dx;
dy := my - y; if dy < 0 then dy := 0 - dy;
if dy > dx then dx := dy;
if dx <= prec then exit;
if ld = dx then begin
ldc := ldc + 1;
if ldc > 4 then begin
addtosystemjournal( 'GotoXY: Cannot reach location!' );
a := 0
repeat
Raw_Move(d,runflag);
a := a+1
until a = e
d := d + 2;
If d = 8 then d:=0 e:= e+1 ldc :=0
end;
end
else ld := dx;
waitconnection(5000);
if mx = x then begin
if my = y then exit;
// North
if my > y then begin Raw_Move(0,runflag); continue; end;
// South
Raw_Move(4,runflag); continue;
end;
if mx < x then begin
// Northeast
if my > y then begin Raw_Move(1,runflag); continue; end;
// East
if my = y then begin Raw_Move(2,runflag); continue; end;
// Southeast
Raw_Move(3,runflag); continue;
end;
// Southwest
if my < y then begin Raw_Move(5,runflag); continue; end;
// West
if my = y then begin Raw_Move(6,runflag); continue; end;
// Nortwest
Raw_Move(7,runflag); continue;
end;
end;
procedure checkcoord;
begin
CheckSave;
checkdead;
begin
if (GetZ(self) = OnBoadZ) then begin
AddToSystemJournal('ïîäõîäèì ê òðàïó')
hodilka(OnBoadX,OnBoadY,0, true);
wait(3000);
{if (GetX(self) = OnBoadX) and (GetY(self) = OnBoadY) then begin
AddToSystemJournal('ñõîäèì íà áåðåã')}
repeat
UseObject(Trap);
wait(1000);
hodilka(nearX,nearY,0, true);
until (GetX(self) = nearX) and (GetY(self) = nearY);
AddToSystemJournal('Ñõîä íà áåðåã çàâåðøåí óñïåøíî');
end
end
end;
procedure CheckAxe;
Begin
AddToSystemJournal('Ïðîâåðÿåì èíñòðóìåíò');
WaitConnection(3000);
CheckSave;
if (Count(AxeType) < 2) then
begin
begin
FindType(Tinktype,ground);
if FindCount < 2 then
begin
UseObject(FindType(TinkType,ground));
WaitTargetobject(findtype(CopperType,ground));
WaitGump(TinkGump)
wait(500);
WaitJournalLine(Now, 'You create|destroy|You put', 30000);
Drophere(FindType(TinkType,backpack));
end
else
begin
repeat
WaitConnection(3000);
CheckSave;
checkdead;
FindType(CopperType,ground);
if FindCount > 0 then
begin
UseObject(FindType(TinkType,ground));
WaitTargetobject(findtype(CopperType,ground));
WaitGump(AxeGump);
wait(500);
WaitJournalLine(Now, 'You create|destroy|You put', 30000);
end
else
begin
AddToSystemJournal('Íå íàéäåí Copper, íå ìîãó ñäåëàòü êèðîê!!!');
FullDisconnect;
end
until Count(AxeType) >= 2
end
end
FindType(TinkType,ground);
Addtosystemjournal('Òóëçîâ íà çåìëå '+intToStr(findfullquantity)+'!');
FindType(CopperType,ground);
Addtosystemjournal('Ìåòàëëà íà çåìëå '+intToStr(findfullquantity)+'!');
end
End;
procedure DropLog;
var g : integer;
logCol : Array [0..16] of Word;
Begin
finddistance := 2;
CheckSave;
AddToSystemJournal('âûáðàñûâàþ äåðåâî â ëîäêó');
logCol[0] := $0000; // normum
logCol[1] := $000B; // elkris
logCol[2] := $0362; // jade
logCol[3] := $010D; // oak
logCol[4] := $0094; // karund
logCol[5] := $01B0; // leshram
logCol[6] := $01A2; // turmalit
logCol[7] := $0026; // emerint
logCol[8] := $00CB; // legrand
logCol[9] := $094A; // solmur
logCol[10] := $092B; // kleor
logCol[11] := $0931; // logradum
logCol[12] := $093F; // vialonit
logCol[13] := $0074; // stardust
logCol[14] := $09EF; // pironil
logCol[15] := $006F; // mystic
logCol[16] := $0119; // elvin
for g := 0 to 16 do
begin
CheckSave;
FindTypeEx(logType,logCol[g],backpack,true);
if FindCount > 0 then
begin
stack(logType,logCol[g]);
wait(500);
end
end
findtype (eda,ground);
Addtosystemjournal('Åäû íà çåìëå '+intToStr(findfullquantity)+'!');
hungry (1,ground);
End;
procedure GotoOnBoad;
{Âîçâðàò ê ëîäêå}
Begin
CheckSave;
checkdead;
hodilka( nearX, nearY, 0,true);
repeat
UseObject(Trap);
wait(1000);
until (GetX(self) = OnBoadX) and (GetY(self) = OnBoadY);
CheckAxe;
End;
procedure CheckEquip;
{Ïðîâåðêà ýêèïèðîâêè}
Var EquipAxe : Cardinal;
Begin
AddToSystemJournal('ïðîâåðêà òîïîðà');
if GetType(ObjAtLayer(LhandLayer)) <> AxeType then
begin
Disarm;
wait(1000);
FindType(AxeType, backpack);
if findCount < 2 then
begin
GotoOnBoad;
end
else
begin
EquipAxe := finditem;
Equip(LhandLayer, EquipAxe);
end
end
checkdead;
End;
Function Lumber(tile:Word;x,y,z:Integer):boolean;
{Ðóáêà äåðåâà}
begin
CheckEquip;
WaitTargetTile(tile,x,y,z);
UseObject(ObjAtLayer(LhandLayer));
WaitJournalLine(now,'enough|how to use|broke|stop|can''t see|far away', 60000);
End;
procedure checkweight;
{Ïðîâåðêà âåñà}
begin
if (Weight > MaxWeight) then begin
AddToSystemJournal('Ïåðåáîð');
GotoOnBoad;
DropLog;
end
checkcoord;
end;
{Èíèöèàëèçàöèÿ ñêðèïòà}
BEGIN
SetArStatus(true);
getcoord;
ClearJournal;
AddToSystemJournal('ñêðèïò çàïóùåí');
While (not Dead) do
begin
for b :=0 to 16 do
begin
WaitConnection(3000);
CheckSave;
CheckDead;
CheckCoord;
CheckWeight;
begin
Addtosystemjournal('Èäó â òî÷êó '+intToStr(LumberP[b].px)+', '+intToStr(LumberP[b].py)+'!');
hodilka(LumberP[b].px,LumberP[b].py,1,true);
Addtosystemjournal('Tree number '+intToStr(b)+'!');
Lumber(LumberP[b].tile,LumberP[b].px,LumberP[b].py,LumberP[b].pz);
end
end
end
end.p.s. есессно идет отдельный файл с тайлами деревьев.
скрипт, вроде бы, не глюкает.
