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

Вопрос по скрипту на ламбер

тут можно задать вопрос по скриптингу
Post Reply
ligeon
Neophyte
Neophyte
Posts: 18
Joined: 22.07.2005 9:15

Вопрос по скрипту на ламбер

Post by ligeon »

Code: Select all

Program LumberJacking;
type LumberR = record
tile:word;
px,py,pz:integer;
end;
Var LumberP: array of LumberR;
logCol : Array [0..16] of Word;
a,d,e : byte;
ItemCount,b:Integer;
MinLogCol: word;
Const
// ==========================Настройки скрипта====================================
nearX = 610 ;  // Координаты на берегу, откуда запрыгивает на лодку, X
nearY = 2083;  // координата Y
onboadx = 610;  // Координаты на лодке, куда попадает после запрыгивания, X
onboady = 2081;  // координата Y
Trap = $6BA360F7; // ID трапа лодки
maxweight = 250; // Максимальный вес с которым может бегать, если превысит то скидывает баласт на землю
MinLog=0;  // Минимальный уровень леса, которой будет носить на лодку, остальное скидывает после рубки
NeedWeight=175;  // Набрав этот вес пойдет разгружаться на лодку
// ================================================================================
maxfood=10;
logType = $1BDD;
AxeType = $0F43;
AxeGump = '3907';
TinkGump = '7865';
eda = $097B;
onboadz = -2;
Tinktype = $1EB9;
CopperType = $1BF2;

{$Include 'library.inc'}	



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('D:\Games\NDW Client\Stealth\Tiles.txt');
for b := 0 to List.Count-1 do
begin
 setArrayLength(LumberP, getArrayLength(LumberP) + 1);
 GetLumberTiles(List.strings[b],b);
end;
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, t : Integer;
begin
FindDistance := 10;
while findtype($0DDA, -1) > 0 do
begin
addtosystemjournal('TELEPORT');
wait(10000);
 end;
ld := 0;   ldc := 0;   d := 0;     e := 2; t:=0;
AddToSystemJournal('... и тут Остапа понеслооо');
  while true do
     begin
      CheckSave;
      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( 'Пытаюсь добраться по координатам...' );
   t:=t+1;
          a := 0
   if (t>=10) then
 begin
  addtosystemjournal('Не удалось добраться по координатам, прерываю ходилку...');
  Exit;    
 end;

          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;
if (GetZ(self) = OnBoadZ) then
begin
repeat
 AddToSystemJournal('Подхожу к трапу...')
 hodilka(OnBoadX,OnBoadY,0, true);
 wait(3000);
 UseObject(Trap);
 wait(2000);
 hodilka(nearX,nearY,0, true);
until (GetX(self) = nearX) and (GetY(self) = nearY);
AddToSystemJournal('Сошел на берег успешно!');
end;
end;

procedure poison;
begin
CheckSave;
if Poisoned then
begin
uosay('Улетая в мир инной я запомню облик твой...')
wait(3000)
if hp > 0 then
uosay('.rescue');
 WaitGump('1');
wait(1000)
fulldisconnect;
end;
end;



procedure CheckAxe;
var food: integer;
Begin
AddToSystemJournal('Проверяю инструменты...');
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 (1000);
AddToSystemJournal('Подкинул '+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(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;
poison;
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('Не могу найти руду, чтобы сделать топоров!');
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;
Begin
finddistance := 1;
CheckSave;
AddToSystemJournal('Скидываю дерево на лодку...');
for g := 0 to 16 do
begin
CheckSave;
FindTypeEx(logType,logCol[g],backpack,true);
if FindCount > 0 then
begin
stack(logType,logCol[g]);
wait(2000);
end;
end;
findtype (eda,ground);
Addtosystemjournal('Еды на земле '+intToStr(findfullquantity)+'');
hungry (1,ground);
End;

procedure GotoOnBoad;
{Возврат к лодке}
Begin
CheckSave;
poison;
repeat
hodilka( nearX, nearY, 0,true);
UseObject(Trap);
wait(1000);
until (GetX(self) = OnBoadX) and (GetY(self) = OnBoadY);
End;

procedure CheckEquip;
{Проверка экипировки}
Var EquipAxe : Cardinal;
Begin
AddToSystemJournal('Проверяю топор...');
if GetType(ObjAtLayer(RhandLayer)) <> AxeType then
  begin
   Disarm;
   wait(1000);
   FindType(AxeType, backpack);
   if findCount < 2 then
    begin
    AddToSystemJournal('Нужен топор, иду на лодку.');
    GotoOnBoad;
    CheckAxe;
    end
     else
    begin
    EquipAxe := finditem;
    Equip(RhandLayer, EquipAxe);
    wait(2000);
    end;
   end;
poison;
End;



procedure CleanPack;
var g : integer;
Begin
finddistance := 1;
CheckSave;
AddToSystemJournal('Скидываю лишнее дерево...');
for g := 0 to MinLog-1 do
begin
CheckSave;
poison;
FindTypeEx(logType,logCol[g],backpack,true);
if FindCount > 0 then
begin
 DropHere(finditem);
 wait(500);
end;
end;
End;

Procedure Lumber(tile:Word;x,y,z:Integer);
{Рубка дерева}
begin
poison;
CheckEquip;
WaitTargetTile(tile,x,y,z);
UseObject(ObjAtLayer(LhandLayer));
AddToSystemJournal('Топор есть, рублю дерево...');
WaitJournalLine(now,'enough|how to use|broke|stop|can''t see|far away', 60000);
End;

procedure checkweight;
var dw: integer;
{Проверка веса}
begin
hungry (1, backpack);
if (Weight > NeedWeight) then  
begin
AddToSystemJournal('Загружен по полной, пора выгружаться');
dw:=Weight - MaxWeight;
if (dw>2)  then
begin
 AddToSystemJournal('Скидываю баласт в '+IntToStr(dw/2)+' бревен и иду на лодку.');
 FindTypeEx(logType,MinLogCol,backpack,true);
 DragItem(finditem, dw/2);
 wait (1000);
 DropItem(Ground, GetX(self), GetY(self), GetZ(self)); 
 wait (1000);
end;
GotoOnBoad;
DropLog;
CheckAxe;
Checkcoord;
poison;
end;
end;

{Инициализация скрипта}
BEGIN
SetArStatus(true);
getcoord;
ClearJournal;
findvertical:=255;
logCol[0] := $0000; // normum
logCol[1] := $0362; // jade
logCol[2] := $010D; // oak
logCol[3] := $0094; // karund
logCol[4] := $01B0; // leshram
logCol[5] := $01A2; // turmalit
logCol[6] := $0026; // emerint
logCol[7] := $00CB; // legrand
logCol[8] := $094A; // solmur
logCol[9] := $092B; // kleor
logCol[10] := $0931; // logradum
logCol[11] := $093F; // vialonit
logCol[12] := $0074; // stardust
logCol[13] := $09EF; // pironil
logCol[14] := $006F; // mystic
logCol[15] := $0119; // elvin
logCol[16] := $000B; // elkris
MinLogCol:=logCol[MinLog];
AddToSystemJournal('----===Скрипт запущен===----');
While (not Dead) do
begin
for b :=0 to ItemCount-1 do
begin
WaitConnection(3000);
CheckSave;
poison;
CheckCoord;
CleanPack;
CheckWeight;
 Addtosystemjournal('Иду в точку '+intToStr(LumberP[b].px)+', '+intToStr(LumberP[b].py)+' к дереву номер '+intToStr(b)+'.');
 hodilka(LumberP[b].px,LumberP[b].py,1,true);
 Addtosystemjournal('Дошел к дереву номер '+intToStr(b)+'.');
 Lumber(LumberP[b].tile,LumberP[b].px,LumberP[b].py,LumberP[b].pz);
end;
end;
end.

Вопрос по данному скрипту. Чар рубит до NeedWeight, сбрасывает простое дерево (logCol[0] := $0000; // normum) на землю и бежит разгружаться. Подскажите, что изменить, чтоб он простое дерево так же носил на лодку?
Alex
Moderator
Moderator
Posts: 351
Joined: 07.04.2005 4:41

Re: Вопрос по скрипту на ламбер

Post by Alex »

там где идет вызов функции CleanPack сделай так:

Code: Select all

if MinLog > 0 then CleanPack;
Новый стелс лежит тут. Стелс это произведение искусства! :)
ligeon
Neophyte
Neophyte
Posts: 18
Joined: 22.07.2005 9:15

Re: Вопрос по скрипту на ламбер

Post by ligeon »

Спасибо за столь быстрый ответ, но не помогло.
Загружен по полной, пора выгружаться
Получаю эту мсг в системжурнал и вновь выбрасывает на землю. Значит дело по ходу в процедуре checkweight? =\
MuDaCk
Apprentice
Apprentice
Posts: 393
Joined: 10.10.2006 0:03
Contact:

Re: Вопрос по скрипту на ламбер

Post by MuDaCk »

Code: Select all

dw:=Weight - MaxWeight;
if (dw>2)  then
begin
 AddToSystemJournal('Скидываю баласт в '+IntToStr(dw/2)+' бревен и иду на лодку.');
 FindTypeEx(logType,MinLogCol,backpack,true);
 DragItem(finditem, dw/2);
 wait (1000);
 DropItem(Ground, GetX(self), GetY(self), GetZ(self)); 
 wait (1000);
Менять надо вот тут.

или тут

Code: Select all

maxweight = 250; // Максимальный вес с которым может бегать, если превысит то скидывает баласт на землю
MinLog=0;  // Минимальный уровень леса, которой будет носить на лодку, остальное скидывает после рубки
NeedWeight=175;  // Набрав этот вес пойдет разгружаться на лодку
My name is Игорёшка Image
Пишу скрипты за едуImage
ligeon
Neophyte
Neophyte
Posts: 18
Joined: 22.07.2005 9:15

Re: Вопрос по скрипту на ламбер

Post by ligeon »

Прости, я тебя не понял =) А что поменять? На что? По поводу checkweight это у меня догадка =)
Alex
Moderator
Moderator
Posts: 351
Joined: 07.04.2005 4:41

Re: Вопрос по скрипту на ламбер

Post by Alex »

да, дело в ней, чар выкладывает дерева что бы стамина не заканчивалась при беге, MuDaCk правильно подсказал, нужно настроить maxweight переменную
Новый стелс лежит тут. Стелс это произведение искусства! :)
ligeon
Neophyte
Neophyte
Posts: 18
Joined: 22.07.2005 9:15

Re: Вопрос по скрипту на ламбер

Post by ligeon »

У меня ещё ни разу вес доходил до maxweight. Увеличить кол-во этой переменной так же пробовал.
MuDaCk
Apprentice
Apprentice
Posts: 393
Joined: 10.10.2006 0:03
Contact:

Re: Вопрос по скрипту на ламбер

Post by MuDaCk »

ligeon wrote:У меня ещё ни разу вес доходил до maxweight. Увеличить кол-во этой переменной так же пробовал.
А он у тебя и не дойдёт до неё)))

Code: Select all

NeedWeight=175;  // Набрав этот вес пойдет разгружаться на лодку
Вот тут надо менять))))
My name is Игорёшка Image
Пишу скрипты за едуImage
ligeon
Neophyte
Neophyte
Posts: 18
Joined: 22.07.2005 9:15

Re: Вопрос по скрипту на ламбер

Post by ligeon »

Доброго времени суток. Поигрался с переменной
NeedWeight=175; // Набрав этот вес пойдет разгружаться на лодку
Как опускал, так и поднимал её... При этом так же регулировал переменную
maxweight = 250; // Максимальный вес с которым может бегать, если превысит то скидывает баласт на землю
Изменений никаких=\
MuDaCk
Apprentice
Apprentice
Posts: 393
Joined: 10.10.2006 0:03
Contact:

Re: Вопрос по скрипту на ламбер

Post by MuDaCk »

Спроси у того, кто писал этот скрипт - это будет легче всего:)
My name is Игорёшка Image
Пишу скрипты за едуImage
ligeon
Neophyte
Neophyte
Posts: 18
Joined: 22.07.2005 9:15

Re: Вопрос по скрипту на ламбер

Post by ligeon »

Увы, этот человек уже с месяц не появлялся тут и в аське не отвечает =( По этому и пришлось тут темку создать.
ligeon
Neophyte
Neophyte
Posts: 18
Joined: 22.07.2005 9:15

Re: Вопрос по скрипту на ламбер

Post by ligeon »

Всем спасибо, разобрались.
Post Reply