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

Страждущим: lumber Vesper Drw

Only working scripts
Beren
Novice
Novice
Posts: 108
Joined: 08.09.2008 1:07

Страждущим: lumber Vesper Drw

Post by Beren »

Code: Select all

Program LumberVesper;

{$Include 'all.inc'}

type
 region= record
  minX:word;
  minY:word;
  maxX:word;
  maxY:word;
 end;

const
 hatcher=$0F43; // тип топора
 count_of_region=4; // количество регионов

 main_chest=$4044E1A6; // сундук с обычными логами
 chest_col_logs=$4044D495; // сундук с ящиком для цветных логов
 box_col_logs=$403D62B6; // ящик с цветными логами

 logs=$1BDD; // тип логов
 Eat=$160A;

 to_house='1025'; // индекс руны домой
 to_vesper='21'; // индекс руны в веспер



 open_door=$06B0;
 close_door=$06AF;

 cl_fn_door=$0839; // тип закрытой двери калитки
 op_fn_door=$083A; // тип открытой двери калитки

 cl_hs_door=$06A5; // тип закрытой двери дома
 op_hs_door=$06A6; // тип открытой двери дома

 runebook=$40536018;

 l_fizzles='You hack at the tree for a while, but fail to produce any useable wood.';
 l_nothing1='There are no logs here to chop.';
 l_nothing2='You can''t reach this.';
 l_needwait ='You must wait to perform another action';
 l_success = 'in your pack.';
 l_bad ='Unexpected target info';
 l_heavy ='at your feet';
 l_far='That is too far away.';
 l_elemental ='Ent';
 l_see='You have no line of sight to that location';
var
 tfta,temp,res_arr:TFoundTilesArray;
 RegArr: array [0..10] of region;
 TreeTile:array [0..9] of word;
 t_x,t_y: word;
 rs,i,j,k,sum,arr_sum:word;

function redcheck:boolean;
var
 n : integer;
 l : TStringList;
 finded : Boolean;
begin
 finddistance:=7;
 finded := False;
 l := TStringList.Create();
 FindType(-1,ground);
 GetFindedList(l);
 if (l.count > 0) then
 begin
  for n:= 0 to (l.count-1) do
     if (IsNPC(StrToInt('$'+l.strings[n]))) then
      if (GetNotoriety(StrToInt('$'+l.strings[n]))>1) then
       if (not IsDead(StrToInt('$'+l.strings[n]))) then finded := true;
 end;
 l.free;
 if WarTargetID<>0 then
   if FindType(GetType(WarTargetID),ground)<>0 then finded := true;
 if finded then result:=true else result:=false;
end;

procedure init;
begin
 //Tile Tree
 TreeTile[0]:=3283;
 TreeTile[1]:=3277;
 TreeTile[2]:=3293;
 TreeTile[3]:=3296;
 TreeTile[4]:=3302;
 TreeTile[5]:=3299;
 TreeTile[6]:=3290;
 TreeTile[7]:=3288;
 TreeTile[8]:=3286;
 TreeTile[9]:=3280;


 // region initialization
 {RegArr[0].minX:=2861;
 RegArr[0].minY:=656;
 RegArr[0].maxX:=2877;
 RegArr[0].maxY:=700;

 RegArr[1].minX:=2847;
 RegArr[1].minY:=710;
 RegArr[1].maxX:=2869;
 RegArr[1].maxY:=724;

 RegArr[2].minX:=2843;
 RegArr[2].minY:=743;
 RegArr[2].maxX:=2869;
 RegArr[2].maxY:=754;}

 RegArr[0].minX:=2907;
 RegArr[0].minY:=779;
 RegArr[0].maxX:=2937;
 RegArr[0].maxY:=790;

 RegArr[1].minX:=2823;
 RegArr[1].minY:=821;
 RegArr[1].maxX:=2842;
 RegArr[1].maxY:=839;

 RegArr[2].minX:=2854;
 RegArr[2].minY:=830;
 RegArr[2].maxX:=2889;
 RegArr[2].maxY:=845;

 RegArr[3].minX:=2848;
 RegArr[3].minY:=932;
 RegArr[3].maxX:=2863;
 RegArr[3].maxY:=962;
end;

procedure Wait_Target(time_ms:Cardinal);
var
 TempTime,SumTime:Cardinal;
begin
 SumTime:=0;
 repeat
  checksave;
  wait(250);
  TempTime:=Timer;
  SumTime:=SumTime+(Timer-TempTime);
 until ((targetpresent) or (dead) or (not connected) or (SumTime>time_ms));
end;

procedure check_hide;
var
 ctime: TDateTime;
begin
 if IsWarMode(self) then setWarMode(false);
 if not isHidden(self) then
  repeat
   ctime:=now;
   UseSkill('Stealth');
   repeat
    checksave;
    wait(350);
   until ((inJournalBetweenTimes('hidden|hide|wait', ctime, Now)<>-1) or (dead) or (not connected));
  until (IsHidden(self) or (dead) or (not connected));
end;

procedure UseAndWait(useitem,waititem:cardinal);
begin
 finddistance:=2;
 while findtype(useitem,ground)<>0 do
  begin
   UseObject(finditem);
   repeat
    wait(250);
    checksave;
   until (findtype(waititem,ground)<>0) ;
  end;
 wait(1000);
end;

{ быстрая сортировка }

procedure qs_all(l, r: integer; var it: TFoundTilesArray);
  var
   i, j: integer;
   x, y: TFoundTile;
  begin
   i:=l; j:=r;
   x:=it[(l+r) div 2];
   repeat
    while (it[i].X+it[i].Y)<(x.X+x.Y) do i := i+1;
     while (x.X+x.Y)<(it[j].X+it[j].Y) do j := j-1;
      if i<=j then
       begin
        y := it[i];
        it[i] := it[j];
        it[j]:= y;
        i := i+1; j := j-1;
       end;
   until i>j;
   if l<j then qs_all(l, j, it);
   if l<r then qs_all(i, r, it);
  end;

procedure qs_X(l, r: integer; var it: TFoundTilesArray);
  var
   i, j: integer;
   x, y: TFoundTile;
  begin
   i:=l; j:=r;
   x:=it[(l+r) div 2];
   repeat
    while it[i].X<x.X do i := i+1;
     while x.X<it[j].X do j := j-1;
      if i<=j then
       begin
        y := it[i];
        it[i]:= it[j];
        it[j]:= y;
        i := i+1; j := j-1;
       end;
   until i>j;
   if l<j then qs_X(l, j, it);
   if l<r then qs_X(i, r, it);
  end;

procedure QuickSort(var item:TFoundTilesArray; count:integer);
begin
 qs_all(0,count-1, item);
 qs_X(0,count-1, item);
end; { конец быстрой сортировки }

procedure equip_tool(type_of_tool:word;layer:Byte); // проверка и одевание предметов
var
 i:word;
begin
   if (GetType(ObjAtLayer(layer))<>type_of_tool) then
    begin
     if layer=RhandLayer then unequip(RhandLayer)else unequip(LhandLayer);
     wait(250);
     if layer=RhandLayer then equipt(RhandLayer,type_of_tool);
     if layer=LhandLayer then equipt(LhandLayer,type_of_tool);
    end;
    i:=0;
  repeat
    i:=i+1;
    wait(500);
    checksave;
   until ((GetType(ObjAtLayer(layer))=type_of_tool) or (dead) or (not connected) or (i>20));
end;

procedure Chop(f_tile:TFoundTile); // процедура рубки
var
 ctime : TDateTime;
 iter_max:integer;
 next_lumb,lumb_result,wait_lumb: string;
 fizzles:word;
begin
 wait_lumb:=l_fizzles+'|'+l_needwait;
 next_lumb:=l_nothing1+'|'+l_nothing2+'|'+l_far+'|'+l_see;;
 lumb_result:=wait_lumb+'|'+next_lumb+'|'+l_success+'|'+l_elemental+'|'+l_bad+'|'+l_heavy;
 fizzles:=0;
 repeat
  equip_tool(hatcher,LhandLayer);
  if TargetPresent then CancelTarget;
  iter_max:=0;
  UseObject(ObjAtLayer(LhandLayer));
  Wait_Target(5000);
  ctime := Now;
  TargetToTile(f_tile.Tile,f_tile.X,f_tile.Y,f_tile.Z);
  repeat
   iter_max:=iter_max+1;
   wait(500);
   checksave;
  until  ((InJournalBetweenTimes(lumb_result, ctime, Now)<>-1) or (iter_max>50));
  if (InJournalBetweenTimes(l_fizzles, ctime, Now)<>-1) then fizzles:=fizzles+1;
 until ((InJournalBetweenTimes(next_lumb, ctime, Now)<>-1) or (fizzles>10));
end;

procedure rec_RB(rune:string); // рекол по РБ
var
 tx,ty,i:word;
begin
 tx:=GetX(self);
 ty:=GetY(self);
 repeat
  UseObject(runebook);
  WaitGump(rune);
  i:=0;
  repeat
   checksave;
   i:=i+1;
   wait(200);
  until ((tx<>GetX(self)) and (ty<>GetY(self))) or (i>60);
 until (tx<>GetX(self)) and (ty<>GetY(self));
end;

procedure unload; // разгрузка
var
 i:integer;
begin
 rec_RB(to_house); // реколимся к калитке дома
 UseAndWait(cl_fn_door,op_fn_door); // открываем калитку
 MoveXY($$$$,$$$$,false,0,false); // идём к двери дома. следует заменить $$$$ соответсвующими координатами
 UseAndWait(cl_hs_door,op_hs_door); // открываем дверь дома
 MoveXY($$$$,$$$$,false,0,false); // входим в дом. следует заменить $$$$ соответсвующими координатами
 //unload color logs
 while FindTypeEx(logs,$0000,backpack,false)<>0 do
  begin
   MoveItem(FindItem,GetQuantity(FindItem),main_chest,0,0,0); // выгружаем обычные логи
   wait(1000);
  end;
 UseObject(chest_col_logs);
 i:=0;
 repeat
  i:=i+1;
  checksave;
  wait(250);
 until (LastContainer=chest_col_logs) or (i>40);
 while FindType(logs,backpack)<>0 do
  begin
   checksave;
   MoveItem(FindItem,GetQuantity(FindItem),box_col_logs,0,0,0); // выыгружаем цветные логи
   wait(1000);
  end;
 rec_RB(to_vesper);
end;

Begin
 SetArStatus(true);
 init;
 sum:=0;
 // поиск деревьев и составление массива
 for j:=0 to count_of_region-1 do
  begin
   arr_sum:=0;
   for i:=0 to 9 do
    begin
     rs:=GetStaticTilesArray(RegArr[j].minX,RegArr[j].minY,RegArr[j].maxX,RegArr[j].maxY,1,TreeTile[i],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);
   for k:=0 to arr_sum-1 do res_arr[sum+k]:=temp[k];
   sum:=sum+arr_sum;
  end;
 // рубка по составленному массиву
 check_hide;
 while not dead do
 for i:=0 to sum-1 do
  begin
   MoveXY(res_arr[i].X,res_arr[i].Y,false,1,false);
   if redcheck then UOSay('guards');
   check_hide;
   chop(res_arr[i]);
   if Weight>=730 then
    begin
     t_x:=GetX(self);
     t_y:=GetY(self);
     unload;
     MoveXY(t_x,t_y,false,0,false);
    end;
  end;
End.
Last edited by Beren on 21.01.2010 13:37, edited 1 time in total.
Beren
Novice
Novice
Posts: 108
Joined: 08.09.2008 1:07

Post by Beren »

Скрипт не без недостатком, ибо впадлу, но на нём уже три чара прокачались))) так что за работоспособность ручаюсь)

1.собственно ходим по трём островам(левее и ниже верхнего) в Веспере и рубим, летаем разгружаться домой.
2. не надо никаких таблиц деревьев, поиск деревьев встроен в скрипт
3. Ентов просто гвардуем.
4. следует указать типы топора которым будете пользоваться, id РБ, типы закрытой/открытой калитки возле дома, типы закрытой/открытой двери в доме.

закомментированы координаты для рубки на самом верхнем острове.
User avatar
Vizit0r
Developer
Developer
Posts: 3958
Joined: 24.03.2005 17:05
Contact:

Post by Vizit0r »

надо было не заморачиваться с переменными о кол-ве регионов, а сделать проще

RegArr: array of region;

запихнул в него сколько надо

а потом просто SizeOf(RegArr).

и удобнее, и меньше вспоминать какие там еще переменные менять при изменении скрипта

а вообще скрипт вроде приличный, по диагонали просмотрел - глаз ни за что не зацепился :)
"Пишите код так, как будто сопровождать его будет склонный к насилию психопат, который знает, где вы живете". (с) Макконнелл, "Совершенный код".
Beren
Novice
Novice
Posts: 108
Joined: 08.09.2008 1:07

Post by Beren »

да это понятно, я ещё хотел сделать более эффективную проработку маршрута, но впадлу))) обошёлся быстрой сортировкой по X+Y, а потом ещё и по X.
Beren
Novice
Novice
Posts: 108
Joined: 08.09.2008 1:07

Post by Beren »

Ктсати,Vizit0r, иногда всё таки вылезает Invalid floating point operation.
http://stealth.od.ua/forum/viewtopic.php?t=1358
User avatar
Vizit0r
Developer
Developer
Posts: 3958
Joined: 24.03.2005 17:05
Contact:

Post by Vizit0r »

наврал. использовать не SizeOf, а GetArrayLength. работает отлично.

Beren

а мне пофиг уже на ту ошибку, в новой версии, та что сейчас в разработке - та процедура отсутствует напрочь. так что могу только советовать ждать...
"Пишите код так, как будто сопровождать его будет склонный к насилию психопат, который знает, где вы живете". (с) Макконнелл, "Совершенный код".
Dsk Roe
Posts: 6
Joined: 30.01.2011 3:19

Post by Dsk Roe »

Beren wrote:Скрипт не без недостатком, ибо впадлу, но на нём уже три чара прокачались))) так что за работоспособность ручаюсь)

1.собственно ходим по трём островам(левее и ниже верхнего) в Веспере и рубим, летаем разгружаться домой.
2. не надо никаких таблиц деревьев, поиск деревьев встроен в скрипт
3. Ентов просто гвардуем.
4. следует указать типы топора которым будете пользоваться, id РБ, типы закрытой/открытой калитки возле дома, типы закрытой/открытой двери в доме.

закомментированы координаты для рубки на самом верхнем острове.

Привет помоги пожалуйста скажи в чём здесь ошибка не как не разобраться
4:21:53 [shuvalovka4]: Compiler: [Error] (LumberVesper;.sc at 51:20): Unknown type 'TFoundTilesArray'
4:21:53 [shuvalovka4]: Compiling failed
4:21:53 [shuvalovka4]: Script LumberVesper;.sc stoped successfuly

var
tfta,temp,res_arr:TFoundTilesArray;
User avatar
Vizit0r
Developer
Developer
Posts: 3958
Joined: 24.03.2005 17:05
Contact:

Post by Vizit0r »

ошибка в древнейшей версии стелса.
"Пишите код так, как будто сопровождать его будет склонный к насилию психопат, который знает, где вы живете". (с) Макконнелл, "Совершенный код".
Dsk Roe
Posts: 6
Joined: 30.01.2011 3:19

Post by Dsk Roe »

Vizit0r wrote:ошибка в древнейшей версии стелса.
craft_bottle;

until (AlchemyFlag = false) or Dead;

FullDisconnect;

End.

Спасибо а ешё вопрос а почему ета ошибка ешё во всех скриптах вылезает Unknown identifier 'FullDisconnect'
а уберая фулл дисконет он делает один раз ману и всё потом скрипт выключаеться ставлю while not Dead do скрипт не выключаеться но повтора действий не происходит. помоги начинаюшему нубу! Зарание спасибо
CoCuCkA
Posts: 5
Joined: 16.02.2011 8:24

Post by CoCuCkA »

[Error] (lumber1.sc at 299:10): comma (',') expected
Помогите пожалуйста понять в чем дело! Выдает такую ошибку сразу, скрипт не запускается(
bugger
Novice
Novice
Posts: 86
Joined: 02.02.2011 11:21

Post by bugger »

Тебе надо поставить на линии 299, 10 символ - запятую.
CoCuCkA
Posts: 5
Joined: 16.02.2011 8:24

Post by CoCuCkA »

Out Of Range at 52.630
а теперь во это выдает((( Че делать народ?
CoCuCkA
Posts: 5
Joined: 16.02.2011 8:24

Post by CoCuCkA »

Ну подскажите пожалуйста что мне делать то.
bugger
Novice
Novice
Posts: 86
Joined: 02.02.2011 11:21

Post by bugger »

Если ты ничего не менял, то:
Аут оф рейндж значит что у тебя был массив допустим для 5 элементов и ты попробовал получить доступ к 6. Или что-то не так с линией 52:
RegArr: array [0..10] of region;

Или я чего-то не понимаю.
Fenix
Developer
Developer
Posts: 275
Joined: 24.08.2010 7:20
Location: Ставрополь
Contact:

Post by Fenix »

У цикла for в паскаль скрипт есть маленькая бага: иногда он делает лишнюю итерацию, соответственно, когда цикл делается для обхода массива, есть варик выйдти за границы. Либо действительно где-то ошибка в скрипте и он обращается за пределы массива.
Помните – ничто так не защищает ваши зубы 12 часов днем и 12 часов ночью как уважительное отношение к окружающим.
"Многие из вас знакомы с достоинствами программиста. Их всего три, и разумеется это: лень, нетерпеливость и гордыня"© Larry Wall
Post Reply