Forum in READ ONLY mode! All questions and discussions on Discord official server, invite link: https://discord.gg/VxsGzJ7

Лесоруб должен жить

тут можно задать вопрос по скриптингу
olimpik
Neophyte
Neophyte
Posts: 26
Joined: 07.11.2016 13:34

Лесоруб должен жить

Post by olimpik »

Скрипт хороший рабочий, понемногу его дополняю вставляя из других скриптов.
Решил дополнить: если лесоруба убивают, он ресается в брите (На Зулу есть особеность при произнесение слова .rescue телепортирует к ближайшему кресту) и возвращается к сундуку за новым комплектом шмоток. Но дает ошибку и не могу понять на что ругается, т.е. на что я понимаю, а вот что его не устраивает.
Красным пометил что дополняю на данном этапе
00:00:24:875 [olimpik3]: Compiler: [Error] (lumber2 - копия.sc at 473:2): Identifier expected

Program Lumber by Olimpik;

{$Include 'all.inc'}

const
/////////////////////////////////////////////////
// Обязательные к изменению настройки скрипта //
Sunduk = $40A881DC; //
// //
// Координаты точки перед сундуком //
xTileSunduk = ххх; //
yTileSunduk = ххх;
RB = $41334EE7;
RunaHome = 1;
//
// //
/////////////////////////////////////////////////

// Возможные к изменению настройки скрипта
MyMaxWeight = 300; // Максимальный вес
Hatchet1 = $0F43; // Тип топора1
Hatchet2 = $0F48; // Тип топора2 (перевёрнутый)
Fish = $097B;

// Размерности массивов
iTTileCount = 39; // Типы тайлов деревьев (менять, только при редактировании массива)
iCTileCount = 8; // Кол-во точек (центров поляны), в которых хотим собирать информацию о деревьях (поляна = 30х30 тайлов)

// Журнал
Msg1 = 'переместили';
Msg2 = 'That is too far away';
Msg3 = 'hack';
Msg4 = 'You stop lumberjacking';
Msg5 = 'no wood here to chop...';
Msg6 = 'appears immune';
Msg7 = 'Try chopping';
Msg8 = 'reach this';

// Прочее
RunSpeed = 250;
iRadiusSearch = 30; // Радиус (не диаметр!) поиска деревьев в тайлах, относительно персонажа
Logs = $1BDD; // Тип логов
WoodType = $0F90; // Тип дедвудов

type
ChopTile = Record
x, y : Integer;
end;

var
Regs : array [1..3] of Cardinal;
FoundTilesArray : TFoundTilesArray;
TempFoundTilesArray, ChopTilesArray : array of TFoundTile;
TreeTile:array [0..iTTileCount] of word;
ChopTiles : array[1..iCTileCount] of ChopTile;
ctime : TDateTime;
i : Integer;

// Инициализация массива типов тайлов деревьев
procedure InitTTilesArray;
begin

TreeTile[0]:=3274;
TreeTile[1]:=3275;
TreeTile[2]:=3277;
TreeTile[3]:=3280;


TreeTile[4]:=3283;
TreeTile[5]:=3286;
TreeTile[6]:=3288;
TreeTile[7]:=3290;


TreeTile[8]:=3293;
TreeTile[9]:=3296;
TreeTile[10]:=3299;
TreeTile[11]:=3302;


TreeTile[12]:=3320;
TreeTile[13]:=3323;
TreeTile[14]:=3326;
TreeTile[15]:=3329;


TreeTile[16]:=3393;
TreeTile[17]:=3394;
TreeTile[18]:=3395;
TreeTile[19]:=3396;


TreeTile[20]:=3415;
TreeTile[21]:=3416;
TreeTile[22]:=3417;
TreeTile[23]:=3418;


TreeTile[24]:=3419;
TreeTile[25]:=3438;
TreeTile[26]:=3439;
TreeTile[27]:=3440;


TreeTile[28]:=3441;
TreeTile[29]:=3442;
TreeTile[30]:=3460;
TreeTile[31]:=3461;


TreeTile[32]:=3462;
TreeTile[33]:=3476;
TreeTile[34]:=3478;
TreeTile[35]:=3480;


TreeTile[36]:=3482;
TreeTile[37]:=3484;
TreeTile[38]:=3492;
TreeTile[39]:=3496;
end;

// Инициализация массива координат для поиска деревьев
procedure InitCTilesArray;
begin
ChopTiles[1].x := 442; // Координаты первой точки, на которую идем и ищем деревья
ChopTiles[1].y := 3436;

ChopTiles[2].x := 462; // Координаты второй точки, на которую идем и ищем деревья
ChopTiles[2].y := 3420;

ChopTiles[3].x := 467; // Координаты третьей точки, на которую идем и ищем деревья
ChopTiles[3].y := 3430;

ChopTiles[4].x := 433; // Координаты третьей точки, на которую идем и ищем деревья
ChopTiles[4].y := 3419;
end;

// Инициализация системных переменных
procedure InitSystem;
begin
SetRunUnmountTimer(RunSpeed);
SetArrayLength(ChopTilesArray, 1);
end;

// Инициализация регов
procedure InitReg;
begin
Regs[1] := $0F85; // Ginseng
Regs[2] := $0F88; // Nightshade
Regs[3] := $0F86; // Mandrake Roots
end;

// Поиск деревьев
procedure SearchTree;
var
i, j : Integer;
var
i, j: Integer;
x, y: TFoundTile;

begin
i := l;
j := r;
x := A[((l + r) div 2)];
repeat
while vector_length(A) < 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;
A:= 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
for i:= 1 to iCTileCount do
begin
NewMoveXY(ChopTiles.x, ChopTiles.y, False, 1, False);
SearchTree;
AddToSystemJournal('Всего найдено деревьев: ' + IntToStr(Length(TempFoundTilesArray)));
ClearDuplicate;
end;
QuickSort(ChopTilesArray, 0, Length(ChopTilesArray) - 1);
end;





procedure checkHatchet1;
begin
if (Count(Hatchet1) < 10) then
begin
NewMoveXY(xTileSunduk, yTileSunduk, false, 1, true);
MoveItem(FindType(Hatchet1, Sunduk),1,Backpack,0,0,0);
Wait(500);
MoveItem(FindType(Hatchet1, Sunduk),1,Backpack,0,0,0);
Wait(500);
MoveItem(FindType(Hatchet1, Sunduk),1,Backpack,0,0,0);
Wait(500);
MoveItem(FindType(Hatchet1, Sunduk),1,Backpack,0,0,0);
Wait(500);
MoveItem(FindType(Hatchet1, Sunduk),1,Backpack,0,0,0);
Wait(500);
MoveItem(FindType(Hatchet1, Sunduk),1,Backpack,0,0,0);
Wait(500);
MoveItem(FindType(Hatchet1, Sunduk),1,Backpack,0,0,0);
Wait(500);
MoveItem(FindType(Hatchet1, Sunduk),1,Backpack,0,0,0);
Wait(500);
MoveItem(FindType(Hatchet1, Sunduk),1,Backpack,0,0,0);
Wait(500);
MoveItem(FindType(Hatchet1, Sunduk),1,Backpack,0,0,0);
Wait(500);
MoveItem(FindType(Hatchet1, Sunduk),1,Backpack,0,0,0);
Wait(500);
MoveItem(FindType(Hatchet1, Sunduk),1,Backpack,0,0,0);
Wait(500);
end;
end;

procedure checkFish;
begin
if (Count(Fish) < 10) then
begin
NewMoveXY(xTileSunduk, yTileSunduk, false, 1, true);
MoveItem(FindType(Fish, Sunduk),15,Backpack,0,0,0);
Wait(500);
end;
end;


// Разгрузка (Edred)
procedure Discharge;
// разгружаем нарубленное в сундук
// нарубленное - реги в массиве Regs[1..3]
// логи - константа Logs
var
m, tmpcnt : integer;
tmpid, tmpstack, tmpcolor : Cardinal;
tmpname : String;
begin
AddToSystemJournal('Разгружаемся');
waitconnection(3000);
if Dead then exit;
UseObject(Sunduk);
wait(1000);
checkHatchet1;
checkFish;
checksave;
// выложим реги
for m := 1 to 3 do
begin
tmpcnt := 0;
Repeat
tmpid := Findtype(Regs[m],backpack);
if tmpid = 0 then break;
addtosystemjournal( 'Найдено ' + inttostr(GetQuantity(tmpid)) + ' regs');
tmpcnt := tmpcnt + 1;
if tmpcnt > 10 then
begin
addtosystemjournal('Ошибка: не могу переместить regs!');
wait(1500);
end;
MoveItem(tmpid,GetQuantity(tmpid),Sunduk,0,0,0);
wait(1000);
CheckSave;
until tmpid = 0;
end;
// выложим дид вуды
tmpcnt := 0;
Repeat
tmpid := Findtype(WoodType,backpack);
if tmpid = 0 then break;
addtosystemjournal( 'Найдено ' + inttostr(GetQuantity(tmpid)) + ' dead woods');
tmpcnt := tmpcnt + 1;
if tmpcnt > 10 then
begin
addtosystemjournal('Ошибка: не могу переместить dead woods!');
wait(1500);
end;
tmpstack := Findtype(WoodType,Sunduk);
// Если не найден в банке - тогда просто в контейнер
if tmpstack = 0 then tmpstack := Sunduk;
MoveItem(tmpid,GetQuantity(tmpid),tmpstack,0,0,0);
wait(1000);
CheckSave;
until tmpid = 0;
// выложим логи
tmpcnt := 0;
Repeat
tmpid := Findtype(Logs,backpack);
if tmpid = 0 then break;
tmpcolor := GetColor(tmpid);
tmpname := ' unknown logs';
case tmpcolor of
$0000 : tmpname := ' logs';
$037F : tmpname := ' Grave logs';
$0039 : tmpname := ' Willow logs';
$0026 : tmpname := ' Maple logs';
$0405 : tmpname := ' Oak logs';
$0994 : tmpname := ' Bloody logs';
$048A : tmpname := ' Nature logs';
$0898 : tmpname := ' Spirits logs';
end;
checkHatchet1;
addtosystemjournal( 'Найдено ' + inttostr(GetQuantity(tmpid)) + tmpname);
tmpcnt := tmpcnt + 1;
if tmpcnt > 10 then
begin
addtosystemjournal('Ошибка: не могу переместить логи');
wait(1500);
end;
repeat
tmpstack := FindtypeEx(Logs,tmpcolor,Sunduk,False);
if GetQuantity(tmpstack) >= 1500 then Ignore(tmpstack);
until (tmpstack = 0) OR (GetQuantity(tmpstack) < 1500);
// Если не найден в сундуке - тогда просто в контейнер
if tmpstack = 0 then tmpstack := Sunduk;
MoveItem(tmpid,GetQuantity(tmpid),tmpstack,0,0,0);
wait(1000);
CheckSave;
until tmpid = 0;
IgnoreReset;
AddToSystemJournal('Разгрузка закончена');
end;

// Идем к сундуку и выгружаемся
procedure UnloadOrDead;
begin
NewMoveXY(xTileSunduk, yTileSunduk, false, 1, false);
if not Dead then begin Discharge; end
else begin AddToSystemJournal('Персонаж мертв.'); SetARStatus(False); Disconnect; end;
end;





procedure Home;
begin
repeat
checksave;
wait(200);
UseObject(RB);
WaitGump(IntToStr(1024 + RunaHome));
wait(3000);
if (GetX(self) <> xTileSunduk) then
begin
Raw_move(Random(7), true);
wait(250);
Raw_move(GetDirection(self), true);
wait(500);
end;
until (GetX(self) = xTileSunduk) or dead
end;






//procedure Recall;
//begin
//Runa[1] := 5; // Nomera run v RB po shahtam [1-16] <Need Setup>
//Runa[2] := 6; //esli netu stolko run prosto povtorit' neskolko odinakovih
//Runa[3] := 7;
//Runa[4] := 8;
//UseObject(RB);
//WaitGump(IntToStr(1024 + Runa[r]));
//wait(4000);
//r:=r+1;
//if (r > 4) then r:=1;
//end;






// Рубим дерево (Edred)
function LumbCurTree(tile,x,y,z : Integer) : Boolean;
// рубим указанный тайл. Возвращаем false если перевес или чар мертв.
var
q, m1, m2, m3, m4, m5, m6, m7, m8, CountFizzle, NextTree : integer;

begin
UseSkill('Arms Lore');
waittargetobject(findtype($0F51,backpack));
Hungry(1,backpack);
wait(1000)
AddToSystemJournal('Logs:'+IntToStr(CountEx($1BDD,$0000,backpack))+' '+'Dead Woods:'+IntToStr(CountEx($0F90,$0000,backpack))+' '+'Hatchet:'+IntToStr(CountEx($0F43,$0000,backpack))+' '+'fish steaks:'+IntToStr(CountEx($097B,$0000,backpack)));

Result := true;
CountFizzle := 0;
repeat
if WarMode = true then SetWarMode(false);
if TargetPresent then CancelTarget;
ctime := Now;
if (ObjAtLayer(LHandLayer) = 0) then
equipt(LHandLayer,Hatchet1);
wait(1000);
if dead then
begin
wait(1000);
uosay('.rescue');
wait(3000);
Addtosystemjournal('y6uJIu!!!');
home;
end;

end;



if UseType(Hatchet1,$FFFF) = 0 then
begin
if UseType(Hatchet2,$FFFF) = 0 then
begin
Result := false;
exit;
end;
end;
WaitForTarget(1000);
If TargetPresent then TargetToTile(tile, x, y, z);
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);
m5 := InJournalBetweenTimes(Msg5, ctime, Now);
m6 := InJournalBetweenTimes(Msg6, ctime, Now);
m7 := InJournalBetweenTimes(Msg7, ctime, Now);
m8 := InJournalBetweenTimes(Msg8, ctime, Now);
until (m1<>-1) or (m2<>-1) or (m3<>-1) or (m4<>-1) or (m5<>-1) or (m6<>-1) or (m7<>-1) or (m8<>-1) or Dead or (q > 150);
if (m2<>-1) or (m3<>-1) or (m4<>-1) then CountFizzle := CountFizzle + 1;
if Dead or (Weight > MyMaxWeight) then begin Result := false; exit; end;
if (q > 150) then NextTree := NextTree + 1;
until (m5<>-1) OR (m6<>-1) OR (m7<>-1) OR (m8<>-1) OR (CountFizzle = 10) OR (NextTree > 3);
if NextTree >= 3 then NextTree := 0;
end;


// Главная функция
Begin
InitTTilesArray;
InitCTilesArray;
InitSystem;
InitReg;
MarkTrees;

repeat
for i:= 0 to Length(ChopTilesArray) - 1 do
begin
NewMoveXY(ChopTilesArray.x, ChopTilesArray.y, false, 1, false);
if not LumbCurTree(ChopTilesArray.tile, ChopTilesArray.x, ChopTilesArray.y, ChopTilesArray[i].z) then UnloadOrDead;
end;
until Dead;
End.SetGlobal
Last edited by olimpik on 25.11.2016 10:42, edited 1 time in total.
olimpik
Neophyte
Neophyte
Posts: 26
Joined: 07.11.2016 13:34

Re: Лесоруб должен жить

Post by olimpik »

причем та же система реса и полета домой на мининг легла без проблем
Last edited by olimpik on 22.11.2016 16:36, edited 1 time in total.
Oasis
Novice
Novice
Posts: 52
Joined: 02.01.2014 14:15

Re: Лесоруб должен жить

Post by Oasis »

procedure Home;
begin
repeat????
checksave;
wait(200);
UseObject(RB);
WaitGump(IntToStr(1024 + RunaHome));
wait(3000);
if (GetX(self) <> xTileSunduk) then
begin
Raw_move(Random(7), true);
wait(250);
Raw_move(GetDirection(self), true);
wait(500);
end;
until (GetX(self) = xTileSunduk) or dead
end;
olimpik
Neophyte
Neophyte
Posts: 26
Joined: 07.11.2016 13:34

Re: Лесоруб должен жить

Post by olimpik »

Ругается вот на эту часть
begin
UseSkill('Arms Lore');
waittargetobject(findtype($0F51,backpack));
Hungry(1,backpack);
wait(1000)
AddToSystemJournal('Logs:'+IntToStr(CountEx($1BDD,$0000,backpack))+' '+'Dead Woods:'+IntToStr(CountEx($0F90,$0000,backpack))+' '+'Hatchet:'+IntToStr(CountEx($0F43,$0000,backpack))+' '+'fish steaks:'+IntToStr(CountEx($097B,$0000,backpack)));

Result := true;
CountFizzle := 0;
repeat
if WarMode = true then SetWarMode(false);
if TargetPresent then CancelTarget;
ctime := Now;
if (ObjAtLayer(LHandLayer) = 0) then
equipt(LHandLayer,Hatchet1);
wait(1000);
if dead then
begin
wait(1000);
uosay('.rescue');
wait(3000);
Addtosystemjournal('y6uJIu!!!');
home;
end;
end;
olimpik
Neophyte
Neophyte
Posts: 26
Joined: 07.11.2016 13:34

Re: Лесоруб должен жить

Post by olimpik »

Oasis wrote:
procedure Home;
begin
repeat????
checksave;
wait(200);
UseObject(RB);
WaitGump(IntToStr(1024 + RunaHome));
wait(3000);
if (GetX(self) <> xTileSunduk) then
begin
Raw_move(Random(7), true);
wait(250);
Raw_move(GetDirection(self), true);
wait(500);
end;
until (GetX(self) = xTileSunduk) or dead
end;
да он может не сразу реснуться или не сразу улететь, поэтому будет пытаться летать до тех пор пока не достигнет xTileSunduk
Oasis
Novice
Novice
Posts: 52
Joined: 02.01.2014 14:15

Re: Лесоруб должен жить

Post by Oasis »

Слепой. Увидел окончание.

Во-первых, такое имя программы не допустимо.

Code: Select all

Program Lumber by Olimpik;
Нужно убрать пробелы в названии

Code: Select all

Program Lumber_by_Olimpik;
Буду дальше смотреть, и обновлять именно этот топик.

Вроде разобрался.
Сейчас по порядку:

1. Имя программы, о чем я писал выше.
2.Я так понял, что ты сам зашифровал тайлы=):

Code: Select all

xTileSunduk = ххх; //
yTileSunduk = ххх;
3. Это все одна процедура. У тебя она обрывается лишним енд`дом, тут:
00:00:24:875 [olimpik3]: Compiler: [Error] (lumber2 - копия.sc at 473:2): Identifier expected

Code: Select all

function LumbCurTree(tile,x,y,z : Integer) : Boolean;
// рубим указанный тайл. Возвращаем false если перевес или чар мертв.
var
q, m1, m2, m3, m4, m5, m6, m7, m8, CountFizzle, NextTree : integer;

begin
UseSkill('Arms Lore');
waittargetobject(findtype($0F51,backpack));
Hungry(1,backpack);
wait(1000)
AddToSystemJournal('Logs:'+IntToStr(CountEx($1BDD,$0000,backpack))+' '+'Dead Woods:'+IntToStr(CountEx($0F90,$0000,backpack))+' '+'Hatchet:'+IntToStr(CountEx($0F43,$0000,backpack))+' '+'fish steaks:'+IntToStr(CountEx($097B,$0000,backpack)));

Result := true;
CountFizzle := 0;
repeat
if WarMode = true then SetWarMode(false);
if TargetPresent then CancelTarget;
ctime := Now;
if (ObjAtLayer(LHandLayer) = 0) then
equipt(LHandLayer,Hatchet1);
wait(1000);
if dead then
begin
wait(1000);
uosay('.rescue');
wait(3000);
Addtosystemjournal('y6uJIu!!!');
home;
end;
end;



if UseType(Hatchet1,$FFFF) = 0 then
begin
if UseType(Hatchet2,$FFFF) = 0 then
begin
Result := false;
exit;
end;
end;
WaitForTarget(1000);
If TargetPresent then TargetToTile(tile, x, y, z);
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);
m5 := InJournalBetweenTimes(Msg5, ctime, Now);
m6 := InJournalBetweenTimes(Msg6, ctime, Now);
m7 := InJournalBetweenTimes(Msg7, ctime, Now);
m8 := InJournalBetweenTimes(Msg8, ctime, Now);
until (m1<>-1) or (m2<>-1) or (m3<>-1) or (m4<>-1) or (m5<>-1) or (m6<>-1) or (m7<>-1) or (m8<>-1) or Dead or (q > 150);
if (m2<>-1) or (m3<>-1) or (m4<>-1) then CountFizzle := CountFizzle + 1;
if Dead or (Weight > MyMaxWeight) then begin Result := false; exit; end;
if (q > 150) then NextTree := NextTree + 1;
until (m5<>-1) OR (m6<>-1) OR (m7<>-1) OR (m8<>-1) OR (CountFizzle = 10) OR (NextTree > 3);
if NextTree >= 3 then NextTree := 0;
end;
Вроде все.
olimpik
Neophyte
Neophyte
Posts: 26
Joined: 07.11.2016 13:34

Re: Лесоруб должен жить

Post by olimpik »

Спасибо
Но вот еще вопрос: при смерти он делает дисконект и я так понимаю что из-за главной фунции которая заканчивает скрипт смертью. Как можно сделать повтор бесконечным или чем его закрыть?
// Главная функция
Begin
InitTTilesArray;
InitCTilesArray;
InitSystem;
InitReg;
MarkTrees;

repeat
for i:= 0 to Length(ChopTilesArray) - 1 do
begin
NewMoveXY(ChopTilesArray.x, ChopTilesArray.y, false, 1, false);
if not LumbCurTree(ChopTilesArray.tile, ChopTilesArray.x, ChopTilesArray.y, ChopTilesArray.z) then UnloadOrDead;
end;
until Dead;
End.SetGlobal
Oasis
Novice
Novice
Posts: 52
Joined: 02.01.2014 14:15

Re: Лесоруб должен жить

Post by Oasis »

// Идем к сундуку и выгружаемся
procedure UnloadOrDead;
begin
NewMoveXY(xTileSunduk, yTileSunduk, false, 1, false);
if not Dead then begin Discharge; end
else begin AddToSystemJournal('Персонаж мертв.'); SetARStatus(False); Disconnect; end;
end;
olimpik
Neophyte
Neophyte
Posts: 26
Joined: 07.11.2016 13:34

Re: Лесоруб должен жить

Post by olimpik »

Oasis wrote:
// Идем к сундуку и выгружаемся
procedure UnloadOrDead;
begin
NewMoveXY(xTileSunduk, yTileSunduk, false, 1, false);
if not Dead then begin Discharge; end
else begin AddToSystemJournal('Персонаж мертв.'); SetARStatus(False); Disconnect; end;
end;
Еще раз спасибо, убрал дисконект и все заработало
Oasis
Novice
Novice
Posts: 52
Joined: 02.01.2014 14:15

Re: Лесоруб должен жить

Post by Oasis »

Пожалуйста=)
olimpik
Neophyte
Neophyte
Posts: 26
Joined: 07.11.2016 13:34

Re: Лесоруб должен жить

Post by olimpik »

Не буду создавать новой темы, подскажи еще пожалуйста вот в этом скрипте на мининг, копает все нормально часами иногда сутками, но иногда выдает вот такую фразу, после чего стает как в копаный, скрипт при этом не вылетает и так же работает, но персонаж больше не двигается.
Я вроде и добавил эту фразу что бы он не обращал внимания и дальше трудился, но это не помогает.
Может можно сделать как то обманку, чтобы при виде фразы заново запускал скрипт или как это устранить?
[22:00:51:190] System: Oh no your tool breaks!
[22:00:51:190] System: You stop mining.
program Mining;
{$Include 'all.inc'}
type
region = record
minX:word;
minY:word;
maxX:word;
maxY:word;
end;
const
clothtype = $0E85;
Fish = $097B;
MyMaxWeight = 200; // Максимальный вес
Ore1 = $19B7; // 1 Ore
Ore2 = $19BA; // 2 Ore
Ore3 = $19B8; // 3 Ore
Ore4 = $19B9; // 4 Ore
Sunduk_ore = $40F702C2; // Sunduk of ore
xs = 4050; // cordinata x sunduka
ys = 317; // coordinata y sunduka
RB = $41335238;
RunaHome = 1;
var
flag1 : Boolean;
X0,Y0,Z0: word;
Tile0: TStaticCell;
W0: Byte;
MinTile:array [0..3] of word;
start_p: TFoundTile;
i,j:word;
RegArr: array [0..0] of region;
sum:word;
arr_sum:word;
rs:word;
tfta:TFoundTilesArray;
k:word;
temp:TFoundTilesArray;
res_arr:TFoundTilesArray;



procedure init;
begin
start_p.X:=GetX(Self);
start_p.Y:=GetY(Self);
MinTile[0]:=1341;
MinTile[1]:=1340;
MinTile[2]:=1339;
MinTile[3]:=1342;
RegArr[0].minX:=start_p.X-10;
RegArr[0].minY:=start_p.Y-10;
RegArr[0].maxX:=start_p.X+10;
RegArr[0].maxY:=start_p.Y+10;
end;
procedure cancel;
begin
CloseMenu;
CancelMenu;
If TargetPresent Then CancelTarget;
end;

procedure Wait_Target(time_ms:Cardinal);
var
TempTime,SumTime:Cardinal;
begin
SumTime:=0;
repeat
checksave;
wait(500);
TempTime:=Timer;
SumTime:=SumTime+(Timer-TempTime);
until ((targetpresent) or (dead) or (not connected) or (SumTime>time_ms));
end;
function sqr(a:LongInt):LongInt;
begin
result:=a*a;
end;
function vector_length(c_1,c_2:TFoundTile):LongInt;
begin
result:=Round(sqrt(sqr(c_1.X-c_2.X)+sqr(c_1.Y-c_2.Y)));
end;
procedure QuickSort(var item:TFoundTilesArray; count:integer; point:TFoundTile);
var
temp_index,temp_value, tempo,i,j:LongInt;
t_c:TFoundTile;
begin
t_c:=point;
temp_index:=0;
temp_value:=vector_length(t_c,item[temp_index]);
for i:=0 to count-2 do
begin
for j:=i to count-1 do
begin
tempo:=vector_length(t_c,item[j]);
if tempo<temp_value then
begin
temp_index:=j;
temp_value:=tempo;
end;
end;
t_c:=item[temp_index];
item[temp_index]:=item;
item:=t_c;
temp_value:=vector_length(item,item[i+1]);
end;
i:=0;
end;
procedure poisk_ore;
begin
SetArStatus(true);
init;
sum:=0;
arr_sum:=0;
rs:=0;
j:=0 ;
for i:=0 to 3 do
begin
rs:=GetStaticTilesArray(RegArr[j].minX,RegArr[j].minY,RegArr[j].maxX,RegArr[j].maxY,0,MinTile,tfta);
if rs > 0 then
for k:=0 to rs-1 do temp[arr_sum+k]:=tfta[k];
arr_sum:=arr_sum+rs;
end;
QuickSort(temp,arr_sum,start_p);
for k:=0 to arr_sum-1 do res_arr[sum+k]:=temp[k];
sum:=sum+arr_sum;
end;
function CheckPickaxe : Boolean;
var tmpser : Cardinal;
begin
Result := true;
if (ObjAtLayerEx(RhandLayer,self) = 0) then
begin
tmpser := findtype(clothtype,backpack);
if tmpser = 0 then tmpser := findtype(clothtype,backpack);
if tmpser = 0 then
begin
Result := false;
exit;
end;
if not equip(RhandLayer,tmpser) then
begin
wait(1000);
if not equip(RhandLayer,tmpser) then
begin
Result := false;
exit;
end;
end;
wait(500);
checksave;
end;
end;
Procedure DoitBaby(f_tile:TFoundTile);
var
ctime : TDateTime;
n,n2:word;
begin
cancel;
repeat
waitconnection(5000);
if not CheckPickaxe then
begin
exit;
end;
if TargetPresent then CancelTarget;
if WarMode = true then SetWarMode(false);
ctime := Now;
UseObject(ObjAtLayerEx(RhandLayer,self));
WaitForTarget(5000);
TargetToTile(f_tile.Tile,f_tile.X,f_tile.Y,f_tile.Z);
ctime := Now;
repeat
wait(2000);
until (InJournalBetweenTimes('There is no metal|no your tool|Oh no your tool breaks!|Oh no your tool breaks!|You loosen|You stop|You cannot| that you must|Это слишком далеко| have|destroyed|anything there', ctime, Now)>= 0)or dead;
until (InJournalBetweenTimes('There is no metal|Oh no your tool breaks!|fail to find|no your tool |Oh no your tool breaks!|anything there| that you must|Это слишком далеко ', ctime, Now)>= 0)or dead;
end;

procedure checkcloth;
begin
if (Count(clothtype) < 4) then
begin
NewMoveXY(xs,ys,false,0,true);
MoveItem(FindType(clothtype, Sunduk_ore),1,Backpack,0,0,0);
Wait(500);
MoveItem(FindType(clothtype, Sunduk_ore),1,Backpack,0,0,0);
Wait(500);
MoveItem(FindType(clothtype, Sunduk_ore),1,Backpack,0,0,0);
Wait(500);
MoveItem(FindType(clothtype, Sunduk_ore),1,Backpack,0,0,0);
Wait(500);
end;
end;

procedure checkFish;
begin
if (Count(Fish) < 10) then
begin
NewMoveXY(xs,ys,false,1,true);
MoveItem(FindType(Fish, Sunduk_ore),10,Backpack,0,0,0);
Wait(500);
end;
end;

procedure Home;
begin
repeat
checksave;
wait(200);
UseObject(RB);
WaitGump(IntToStr(1024 + RunaHome));
wait(3000);
if (GetX(self) <> xs) then
begin
Raw_move(Random(7), true);
wait(250);
Raw_move(GetDirection(self), true);
wait(500);
end;
until (GetX(self) = xs) or dead
end;


function DischargeSunduk : Boolean;
var tmpcnt : Integer;
tmpid, tmpstack : Cardinal;
tmpconnect : TDateTime;
begin
addtosystemjournal('Пришли на разгрузку');
Result := true;
tmpconnect := ConnectedTime;
if Dead then
begin
Result := false;
exit;
end;
UseObject(Sunduk_ore);
Hungry(1,backpack);
checksave;
checkcloth;
checkFish;
// Переместим руду
tmpcnt := 0;
repeat
tmpid := Findtype(Ore1,backpack);
if tmpid = 0 then tmpid := Findtype(Ore2,backpack);
if tmpid = 0 then tmpid := Findtype(Ore3,backpack);
if tmpid = 0 then tmpid := Findtype(Ore4,backpack);
if tmpid = 0 then break;
tmpcnt := tmpcnt + 1;
if tmpcnt > 10 then
begin
addtosystemjournal('Ошибка: не могу переместить руду!');
Result := false;
exit;
end;
repeat
tmpstack := FindtypeEx(Ore1,GetColor(tmpid),Sunduk_ore,False);
if tmpstack = 0 then tmpstack := FindtypeEx(Ore2,GetColor(tmpid),Sunduk_ore,False);
if tmpstack = 0 then tmpstack := FindtypeEx(Ore3,GetColor(tmpid),Sunduk_ore,False);
if tmpstack = 0 then tmpstack := FindtypeEx(Ore4,GetColor(tmpid),Sunduk_ore,False);
if GetQuantity(tmpstack) >= 65000 then Ignore(tmpstack);
until (tmpstack = 0) OR (GetQuantity(tmpstack) < 65000);
// Если не найден в сундуке - тогда просто в контейнер
if tmpstack = 0 then tmpstack := Sunduk_ore;
MoveItem(tmpid,GetQuantity(tmpid),tmpstack,0,0,0);
wait(1000);
CheckSave;
until tmpid = 0;
IgnoreReset;

end;


procedure DropMap;
begin

//Addtosystemjournal('Выбрасываю карты');
repeat
FindTypeEx($14ED,$ffff,backpack,True);
if (findcount > 0) then Drop(finditem, 0, 0, 0, 0);;
wait(100);
checksave;
until findcount = 0;
end;

procedure CheckCon;
begin
if Connected=False then
begin;
repeat
Wait(1000);
until Connected=True;
Wait(5000);
end;
end;


begin
checkcloth;

W0:=WorldNum;
while not dead do
begin
X0:=GetX(Self);
Y0:=GetY(Self);
Z0:=GetZ(Self);
Tile0:=ReadStaticsXY(X0,Y0,W0);
poisk_ore;
NewMoveXY(X0-1,Y0,false,0,false);
j:=sum-1;
i:=0;
while (i<j)and(Not Dead) do
begin
X0:=GetX(Self);
Y0:=GetY(Self);

NewMoveXY(res_arr.X,res_arr.Y,false,1,false);
if (x0=res_arr.x) and (y0=res_arr.y) then
NewMoveXY(X0-1,Y0,false,1,false);
X0:=GetX(Self);
Y0:=GetY(Self);
if (x0=res_arr.x) and (y0=res_arr.y) then
NewMoveXY(X0+1,Y0,false,1,false);
X0:=GetX(Self);
Y0:=GetY(Self);
if (x0=res_arr[i].x) and (y0=res_arr[i].y) then
NewMoveXY(X0,Y0-1,false,1,false);
X0:=GetX(Self);
Y0:=GetY(Self);
if (x0=res_arr[i].x) and (y0=res_arr[i].y) then
NewMoveXY(X0,Y0+1,false,1,false);
DoitBaby(res_arr[i]);
i:=i+1;
AddToSystemJournal('МойВес:'+inttostr(weight)+' '+'МаксВес:'+inttostr(MyMaxWeight)+' '+'Кирок:'+inttostr(CountEx($0E85,$0000,backpack))+' '+'Стейков:'+inttostr(CountEx($097B,$0000,backpack)));

if Dead or (Weight > MyMaxWeight)then
begin
DropMap;
NewMoveXY(xs,ys,false,0,true);

repeat
if dead then
begin
wait(20000);
uosay('.rescue');
wait(20000);
Addtosystemjournal('y6uJIu!!!');
home;
useobject(Sunduk_ore);
wait(3000);
findtype($1F4C,Sunduk_ore);
checksave;
if (findcount > 0) then MoveItem(finditem, 1, RB, 0,0,0);
wait(3000);
end;
flag1 := DischargeSunduk;
wait(100);
until flag1 = true;
end;
end;
end;
end.
Oasis
Novice
Novice
Posts: 52
Joined: 02.01.2014 14:15

Re: Лесоруб должен жить

Post by Oasis »

Code: Select all

until (InJournalBetweenTimes('There is no metal|no your tool|Oh no your tool breaks!|Oh no your tool breaks!|You loosen|You stop|You cannot| that you must|Это слишком далеко| have|destroyed|anything there', ctime, Now)>= 0)or dead;
until (InJournalBetweenTimes('There is no metal|Oh no your tool breaks!|fail to find|no your tool |Oh no your tool breaks!|anything there| that you must|Это слишком далеко ', ctime, Now)>= 0)or dead;
end;
Я ничего тут не понял, зачем 100500 дубликатов?
Зачем два раза парсить?
drabadan
Expert
Expert
Posts: 730
Joined: 13.12.2012 17:35
Contact:

Re: Лесоруб должен жить

Post by drabadan »

Oasis wrote:

Code: Select all

until (InJournalBetweenTimes('There is no metal|no your tool|Oh no your tool breaks!|Oh no your tool breaks!|You loosen|You stop|You cannot| that you must|Это слишком далеко| have|destroyed|anything there', ctime, Now)>= 0)or dead;
until (InJournalBetweenTimes('There is no metal|Oh no your tool breaks!|fail to find|no your tool |Oh no your tool breaks!|anything there| that you must|Это слишком далеко ', ctime, Now)>= 0)or dead;
end;
Я ничего тут не понял, зачем 100500 дубликатов?
Зачем два раза парсить?
уровни вложенности. Верхний отвечает за логику, нижний за ожидание.
Oasis
Novice
Novice
Posts: 52
Joined: 02.01.2014 14:15

Re: Лесоруб должен жить

Post by Oasis »

ничего подобного ранее не встречал.

Автор, а при каких обстоятельствах он это пишет? в шахте или на месте сброса реса и крафтинга кирок?
olimpik
Neophyte
Neophyte
Posts: 26
Joined: 07.11.2016 13:34

Re: Лесоруб должен жить

Post by olimpik »

В шахте, кирка при этом не ломается, и вообще ни чего не ломается кроме скрипта :D
и это происходит не в одной точке, и в разное время
Post Reply