Program camping;
/// Настройки ///
const
RadiusX=20;
RadiusY=20;
Axe=$0F51;//кинжал
StartXY=true;
StartX=948;// Обязательно заполните эти значения
StartY=382;// .where вам в помощь
////////////////////
//v. 1.1
//Remake of lumber script by Rabies
type
TreeRecord = Record
t,x,y: integer;
end;
var
TreeTile: array[0..50] of integer;
TreePlace: array[0..500] of TreeRecord;
TreeCount: integer;
x,y,c,a,s: integer;
procedure CheckCon;
begin
if Connected=False then
begin;
repeat
Wait(1000);
until Connected=True;
Wait(5000);
end;
end;
function CheckTool: boolean;
begin
CheckCon;
FindType(Axe, backpack);
if (dead=false) and (FindCount = 0) and (ObjAtLayer(LHandLayer) = 0) then
begin
AddToSystemJournal('Нет кинжала');//что было бы странно впрочем
s:=0;
result:=false;
end
else
result:=true;
end;
procedure CheckTree;
var
LCount: integer;
t,i: integer;
TTile: TStaticCell;
begin
TTile:=ReadStaticsXY(x, y, worldnum);
LCount:=GetLayerCount(x, y, worldnum);
i:=0;
while i < LCount do
begin
for t:=0 to 32 do
begin
if TTile.Statics.Tile=TreeTile[t] then
begin
TreePlace[c].t:=TTile.Statics.Tile;
TreePlace[c].x:=x;
TreePlace[c].y:=y;
c:=c+1;
end;
end;
i:=i+1;
end;
end;
procedure FindTree;
begin
for x:=GetX(self)-RadiusX to GetX(self)+RadiusX do
if x mod 2 = 0 then
begin
for y:=GetY(self)-RadiusY to GetY(self)+RadiusY do
CheckTree;
end
else
begin
for y:=GetY(self)+RadiusY downto GetY(self)-RadiusY do
CheckTree;
end;
TreeCount:=c-1;
end;
procedure DropKindle;
begin
wait(500);
FindType($0DE1,Backpack);
if FindCount > 0 then Drophere(finditem);
end;
procedure BurnKindle;
begin
wait(500);
FindType($0DE1,Ground);
while (FindCount > 0) and (not Dead) do
begin
FindType($0DE1,Ground);
if FindCount > 0 then
begin
useobject(finditem);
wait(500);
end;
end;
end;
procedure Lumber;
var
t: TDateTime;
i:integer;
begin
for a:=0 to TreeCount do
begin
CheckCon;
t:=now;
MoveXY(TreePlace[a].x, TreePlace[a].y, true, 1, false);
if ObjAtLayer(LHandLayer) = 0 then
Wait(2000);
if (CheckTool=true) and (Dead=false) then
begin
for i:= 0 to 30 do //надо бы парсить журнал, но мне в лом =) так что просто 30 раз будем ковырять дерево.
begin
WaitTargetTile(TreePlace[a].t, TreePlace[a].x, TreePlace[a].y, 0);
UseType(Axe, $FFFF);
wait(500);
end;
DropKindle;
BurnKindle;
end
else break;
end;
end;
begin
c:=0;
s:=1;
TreeTile[0]:=3277;
TreeTile[1]:=3283;
TreeTile[2]:=3286;
TreeTile[3]:=3289;
TreeTile[4]:=3291;
TreeTile[5]:=3294;
TreeTile[6]:=3296;
TreeTile[7]:=3299;
TreeTile[8]:=3302;
TreeTile[9]:=3393;
TreeTile[10]:=3394;
TreeTile[11]:=3395;
TreeTile[12]:=3396;
TreeTile[13]:=3415;
TreeTile[14]:=3416;
TreeTile[15]:=3417;
TreeTile[16]:=3418;
TreeTile[17]:=3419;
TreeTile[18]:=3438;
TreeTile[19]:=3439;
TreeTile[20]:=3440;
TreeTile[21]:=3441;
TreeTile[22]:=3442;
TreeTile[23]:=3460;
TreeTile[24]:=3461;
TreeTile[25]:=3462;
TreeTile[26]:=3290;
TreeTile[27]:=3288;
TreeTile[28]:=3480;
TreeTile[29]:=3240;
TreeTile[30]:=3242;
TreeTile[31]:=3488;
TreeTile[32]:=3482;
CheckCon;
if StartXY=true then
MoveXY(StartX, StartY, true, 0, false);
FindTree;
AddToSystemJournal('Найдено деревьев: '+IntToStr(TreeCount));
while (s=1) and (CheckTool=true) do
begin
if StartXY=true then if Dead then
begin
wait(20000);
uosay('.rescue');
wait(10000);
if (not Dead) then MoveXY(StartX, StartY, true, 0, false);
end;
Lumber;
end;
SetARStatus(false);
Disconnect;
end.
script by Dess
