Includes

[Mirage]

А теперь прошу пояснения: зачем предлагать в общие инклюды функции, заточенные под конкретный шард? Названия, цвета металлов, требуемый скилл - это одно из первых, что на разных шардах изменяют под себя.

Code: Select all

procedure CheckLag;
var starttime : TDateTime;
begin
	starttime := Now;
	ClickOnObject(backpack);
	repeat
		wait(50);
	until (InJournalBetweenTimes('ackpack', starttime, Now)<>-1);
end;

я ее в include засунул для себя лично.

тогда уж так вот более универсально . На разных шардах по разному написана буква. Для минера выложено для ДРВ - автор подписал.

[WladL]

тогда уж так вот более универсально . На разных шардах по разному написана буква. Для минера выложено для ДРВ - автор подписал.

Этот CheckLag уже не актуален ибо есть встроенный в стелс.
http://stealth.od.ua/forum/viewtopic.php?p=6042#6042

[RaTaMaHaTTa]

тогда уж так вот более универсально . На разных шардах по разному написана буква. Для минера выложено для ДРВ - автор подписал.

Этот CheckLag уже не актуален ибо есть встроенный в стелс.
http://stealth.od.ua/forum/viewtopic.php?p=6042#6042

Не все пользуются новым стелсом , например я сижу на 3 кандидате.
Ибо мне лень переписовать скрипты.

[WladL]

Function NextVendor(pX1,pY1,pX2,pY2:Integer; CheckInArea:Boolean; Distance:Integer; var X,Y:Integer; var vName:String):Boolean;

При каждом последующем вызове функция вовзращает имя и координаты следующего вендора находящегося в координатах pX1,pY1-pX2,pY2 если CheckInArea=true , иначе вендоры ищутся на расстоянии Distance. Найденый вендор добавляется в игнор-лист. Distance должна быть указана в любом случае.

Code: Select all

Function NextVendor(pX1,pY1,pX2,pY2:Integer; CheckInArea:Boolean; Distance:Integer; var X,Y:Integer; var vName:String):Boolean;
var
Cur_Vend:Cardinal;
begin
Ignore(Self);
X:=0;
Y:=0;
vName:='';
Result:=false;
FindDistance:=Distance;
repeat
	Cur_Vend:=FindType($0190,Ground);
	Ignore(FindItem);
Until (((GetX(Cur_Vend)>=pX1) And (GetX(Cur_Vend)<=pX2) AND (GetY(Cur_Vend)>=pY1) AND (GetY(Cur_Vend)<=pY2)) And (CheckInArea)) OR (Cur_Vend=0);
if Cur_Vend > 0 then begin
	X:=GetX(Cur_Vend);
	Y:=GetY(Cur_Vend);
	vName:=GetName(Cur_Vend);
	Result:=True;
end else begin
	repeat
		Cur_Vend:=FindType($0191,Ground);
		Ignore(FindItem);
	Until (((GetX(Cur_Vend)>=pX1) And (GetX(Cur_Vend)<=pX2) AND (GetY(Cur_Vend)>=pY1)AND (GetY(Cur_Vend)<=pY2)) And (CheckInArea)) OR (Cur_Vend=0);
	if Cur_Vend > 0 then begin
		X:=GetX(Cur_Vend);
		Y:=GetY(Cur_Vend);
		vName:=GetName(Cur_Vend);
		Result:=True;
	end;
end;
end;

Примеры использования:

Code: Select all

1) Обход всех вендоров в координатах от 1111,333 до 2222,333
var
vendor_X,vendor_Y:Integer;
vendor_Name:String;
begin
AutoBuy($0000,$0000,10);
FindVertical:=100;//<<<<<<!!!!!!
while NextVendor(1111,333,2222,333,true,20,vendor_X,vendor_Y,vendor_Name) do
	begin 
		MoveXY(vendor_X,vendor_Y,false,1,false);
		UOSay('Bye '+vendor_Name+' Buy');
		CheckSave;
		wait(3000);
	end;
	IgnoreReset;
end;

Code: Select all

2) Поиск вендоров находящимся на расстоянии до 15 тайлов
var
vendor_X,vendor_Y:Integer;
vendor_Name:String;
begin
AutoBuy($0000,$0000,10);
FindVertical:=100;<<<<<<!!!!!!
while NextVendor(0,0,0,0,false,15,vendor_X,vendor_Y,vendor_Name) do
	begin 
		MoveXY(vendor_X,vendor_Y,false,1,false);
		UOSay('Bye '+vendor_Name+' Buy');
		CheckSave;
		wait(3000);
	end;
	IgnoreReset;
end;

"Лайт" версия той-же функции без заморочек по поводу площади поиска.Поиск просто на заданной дистанции.

Function NextVendor2( Distance:Integer; var X,Y:Integer; var vName:String):Boolean;

Code: Select all

Function NextVendor2(Dist:Integer; var X,Y:Integer; var vName:String):Boolean;
var
Cur_Vend:Cardinal;
begin
Ignore(Self);
X:=0;
Y:=0;
vName:='';
Result:=false;
FindDistance:=Dist;
	Cur_Vend:=FindType($0190,Ground);
	Ignore(FindItem);
if Cur_Vend > 0 then begin
	X:=GetX(Cur_Vend);
	Y:=GetY(Cur_Vend);
	vName:=GetName(Cur_Vend);
	Result:=True;
end else begin
		Cur_Vend:=FindType($0191,Ground);
		Ignore(FindItem);
	if Cur_Vend > 0 then begin
		X:=GetX(Cur_Vend);
		Y:=GetY(Cur_Vend);
		vName:=GetName(Cur_Vend);
		Result:=True;
	end;
end;
end;

Пример использования:

Code: Select all

2) Поиск вендоров находящимся на расстоянии до 15 тайлов
var
vendor_X,vendor_Y:Integer;
vendor_Name:String;
begin
AutoBuy($0000,$0000,10);
FindVertical:=100;<<<<<<!!!!!!
while NextVendor2(15,vendor_X,vendor_Y,vendor_Name) do
	begin 
		MoveXY(vendor_X,vendor_Y,false,1,false);
		UOSay('Bye '+vendor_Name+' Buy');
		CheckSave;
		wait(3000);
	end;
	IgnoreReset;
end;

Не забываем про глобальный параметр FindVertical который должен быть предварительно установлен на значение не меньшее чем координата Z у предполагаемого вендора

Code: Select all

FindVertical:=GetZ(self)+10;

ну или

Code: Select all

FindVertical:=100; //чтоб уж совсем не парится ^)

[grundick]

Сорри за оффтоп, это не твой бот по рынкам ползает?

[RaTaMaHaTTa]

Сорри за оффтоп, это не твой бот по рынкам ползает?

[NoSilence]

Code: Select all

function Find(ItemType: word):cardinal;
begin
result:= FindType(ItemType, Backpack);
end;

function FindGround(ItemType: word):cardinal;
begin
result:= FindType(ItemType, Ground);
end;

function FindTypeA(ItemTypes: array of word; Container: cardinal):cardinal;
var
  i: integer;
begin
if Length(ItemTypes) = 0 then exit;
for i:= 0 to Length(ItemTypes)-1 do 
  if FindType(ItemTypes[i], Container) > 0 then begin
    result:= FindItem;
    exit;
  end;
end;

function FindA(ItemType: array of word):cardinal;
begin
result:= FindTypeA(ItemType, Backpack);
end;

function FindGroundA(ItemType: array of word):cardinal;
begin
result:= FindTypeA(ItemType, Ground);
end;

function FindTypeB(ItemTypes: array of word; Container: cardinal; var OutArray: array of cardinal):integer;
var
  i: integer;
  t: TStringList;
begin
if Length(ItemTypes) = 0 then exit;
t:= TStringList.Create;
for i:= 0 to Length(ItemTypes)-1 do 
  if FindType(ItemTypes[i], Container) > 0 then
    GetFindedList(t);
SetLength(OutArray, t.Count);
for i:= 0 to t.Count-1 do
  OutArray[i]:= StrToInt('$'+t[i]);
result:= t.Count;
t.Free;
end;

function FindTypeC(ItemTypes: array of word; Container: cardinal; CallBackFunc: function(FindItem: cardinal):boolean):integer;
var
  i: integer;
  FoundItems: array of cardinal;
begin
if CallBackFunc = nil then exit;
result:= FindTypeB(ItemTypes, Container, FoundItems);
for i:= 0 to result-1 do
  if not CallBackFunc(FoundItems[i]) then break;
end;

Небольшие профиты по поиску предметов

function FindTypeA(ItemTypes: array of word; Container: cardinal):cardinal;
Возвращает ИД первого найденного предмета по типам.

Code: Select all

FindTypeA([$0190, $0191], Ground)

Найдет телку или пацанчика

function FindTypeB(ItemTypes: array of word; Container: cardinal; var OutArray: array of cardinal):integer;
Записывает все ИД найденных предметов по типам и возвращает длину массива

Code: Select all

var
  FoundArray: array of cardinal;
  FoundCound, i: integer;

begin
FoundCound:= FindTypeB([$0190, $0191], Ground, FoundArray);
for i:= 0 to FoundCount-1 do begin
  UOSay('.kill');
  if WaitForTarget(3000) then TargetToObject(FoundArray[i]);
end;
end.

Идеально подходит для любого ГМа.
Либо так:

function FindTypeC(ItemTypes: array of word; Container: cardinal; CallBackFunc: function(FindItem: cardinal):boolean):integer;

Code: Select all

function KillTarget(FindItem: cardinal):boolean;
begin
UOSay('.kill');
if WaitForTarget(3000) then TargetToObject(FindItem);
result:= true;
end;

begin
FindTypeC([$0190, $0191], Ground, @KillTarget);
end.

Еще один профит для ламерюг

Code: Select all

function FindObject(ItemType: word; Container: cardinal):cardinal;
begin
result:= FindType(ItemType, Container);
end;

Поиск объекта по типу.

[Tiger89]

NoSilence, можно ещё параметр FindDistance добавить в твои процедуры, очень полезные штуки ты написал спасибо =)

[NoSilence]

NoSilence, можно ещё параметр FindDistance добавить в твои процедуры, очень полезные штуки ты написал спасибо =)

Это что ли?

Code: Select all

var
  otherinc_FindDistance: byte;

function BeginFindDistance(FindDistanceValue: integer):integer;
begin
otherinc_FindDistance:= FindDistance;
result:= otherinc_FindDistance;
FindDistance:= FindDistanceValue;
end;

function EndFindDistance:integer;
begin
result:= FindDistance;
FindDistance:= otherinc_FindDistance;
end;

Продолжая тему "Хроники говнокодера":

getword.inc

Code: Select all

const
  getwordinc_IgnoreQuotes = false;

function GetWord(const Text: string; BreakSymbol: char; Index: integer):string;
var
  i: integer;
  quote, lastbreak: boolean;
begin
lastbreak:= true;
quote:= false;
result:= '';

if Index > 0 then
  for i:= 1 to Length(Text) do
    if (Text[i] = #27) and (not getwordinc_IgnoreQuotes) then
       quote:= not quote
    else if (Text[i] = BreakSymbol) and (not quote) then begin
      if not lastbreak then begin
        Index:= Index - 1;
        lastbreak:= true;
      end;
      if Index < 1 then break;
    end else begin
      lastbreak:= false;
      if Index = 1 then
        result:= result + Text[i];
    end
else
  for i:= Length(Text) downto 1 do
    if (Text[i] = #27) and (not getwordinc_IgnoreQuotes) then
       quote:= not quote
    else if (Text[i] = BreakSymbol) and (not quote) then begin
      if not lastbreak then begin
        Index:= Index + 1;
        lastbreak:= true;
      end;
      if Index > -1 then break;
    end else begin
      lastbreak:= false;
      if Index = -1 then
        result:= Text[i] + result;
    end
end;

type
  TParsedString = array of string;

function GetWordEx(const Text: string; BreakSymbol: char; var OutArray: TParsedString):integer;
var
  i: integer;
  line: string;
  quote: boolean;
begin
SetLength(OutArray, 0);
quote:= false;
line:= '';

for i:= 1 to Length(Text) do
  if (Text[i] = #27) and (not getwordinc_IgnoreQuotes) then
     quote:= not quote
  else if (Text[i] = BreakSymbol) and (not quote) then begin
    if Length(line) = 0 then continue;
    SetLength(OutArray, Length(OutArray) + 1);
    OutArray[High(OutArray)]:= line;
    line:= '';
  end else
    line:= line + Text[i];
if Length(line) > 0 then begin
  SetLength(OutArray, Length(OutArray) + 1);
  OutArray[High(OutArray)]:= line;
end;

result:= Length(OutArray);
end;

function ExtractFileName(const FileName: string):string;
begin
result:= GetWord(FileName, '\', -1);
end;

function ExtractDir(const FileName: string):string;
begin
result:= Copy(FileName, 1, Length(FileName) - Length(ExtractFileName(FileName)) - 1);
end;

function GetWord(const Text: string; BreakSymbol: char; Index: integer):string;
Извлекает из строки Text слово под номером Index (если отрицательное, то с конца), разбивая по символу BreakSymbol. При этом учитываются кавычки. Например:

Code: Select all

GetWord('   123    44555 66   333', ' ', 3)

Функция вернет '66'.

Code: Select all

GetWord('   123    44555 66   333', ' ', -3)

Функция вернет '44555'.


function GetWordEx(const Text: string; BreakSymbol: char; var OutArray: TParsedString):string;
Разбивает строку Text по символу BreakSymbol, записывает результат в массив строк OutArray и возвращает его длину. Например:

Code: Select all

GetWordEx('   123    44555 66   333', ' ', array)

Функция вернет 4. А в массив array запишутся следующие строки: '123', '44555', '66' и '333'.

Так же в комплекте идут:
function ExtractFileName(const FileName: string):string;
function ExtractDir(const FileName: string):string;

Code: Select all

ExtractFileName('E:\Games\UO\client.exe') = 'client.exe'
ExtractDir('E:\Games\UO\client.exe') = 'E:\Games\UO'

[CFA]

Ходилка. Практически аналогичная встроенной стелсовской.
Из отличий - возможность вызова callback функции на каждый шаг, но это сейчас закомментировано, тк PascalScript не понимает nil в качестве указателя на функцию.
//if assigned(callback) and not callback(path[idx].x, path[idx].y) then exit;
вот это надо раскомментировать, чтобы callback заработал.
И еще важное отличие - Mover заканчивает работу, до того как чар не дошел до указанной точки - обычно чар находится в 3-4 тайлах от конечной точки, и дойдет до нее за 400-1500 мсек, но в редких случаях может и не дойти.

Code: Select all

unit mover3d;

interface

type TMoveCallback = function(x, y : Integer) : Boolean;

function Mover(x, y, z, acc, accz : Integer; run : Boolean; callback : TMoveCallback): boolean;

implementation

function _Step(dir : Byte; run : Boolean) : boolean;
var res : Integer;
begin
  while true do
  begin
    res := StepQ(dir, run);
    result := res >= 0;
    // шаг сделан успешно или шагнуть в этом направлении нельзя - выходим
    // иначе (очередь шагов заполнена) ждем и пробуем шагнуть опять
    if (res >= 0) or (res = -2) then break;
    wait(10);
  end;
end;


function Mover(x, y, z, acc, accz : Integer; run : Boolean; callback : TMoveCallback): boolean;
var path : TPathArray;
    cnt, idx, i, cx, cy, cz, steps, dx, dy : Integer;
    destX, destY : Word;
    destZ : ShortInt;
    recompute : Boolean;
    dir : Byte;
begin
  result := False;
  recompute := True;

  while true do
  begin
    // рассчитываем путь
    if recompute then
    begin
      addToSystemJournal('Расчет пути');
      recompute := False;
      cnt := GetPathArray3D(PredictedX, PredictedY, PredictedZ, x, y, z, WorldNum, acc, accz, run, path);
      if cnt <= 0 then 
      begin
        addToSystemJournal('Невозможно найти путь');
        exit;
      end;
      idx := 0; 
    end;
    
    cx := PredictedX;
    cy := PredictedY;
    cz := PredictedZ;

    // проверка проходимости на 4 шага вперед 
    steps := idx + 4;
    if steps >= cnt then steps := cnt-1;
    
    for i := idx to steps do
    begin
      destX := path[i].X;
      destY := path[i].Y;
      if IsWorldCellPassable(cx, cy, cz, destX, destY, destZ, WorldNum) then
      begin
        cx := destX;
        cy := destY;
        cz := destZ;
      end
      else
      begin
        // точка по курсу не проходима, надо считать путь но новой
        addToSystemJournal('Непроходимая точка ' + intToStr(destX) + ' ' + intToStr(destY));
        recompute := True;
        break;
      end;
    end;
    
    if recompute then continue;
    
    // ждем пока будет достаточно стамины
    while (not Dead) and (Stam < moveCheckStamina) do
      Wait(100);
      
    // Расстояние до точки
    dx := Integer(PredictedX) - Integer(path[idx].x);
    dy := Integer(PredictedY) - Integer(path[idx].y);

    // уже стоим на точке куда надо шагнуть, или точка дальше чем в одном тайле
    // значит какая то фигня - надо посчитать путь но новой 
    if ((dx = 0) and (dy = 0)) or ((abs(dx) > 1) or (abs(dy) > 1)) then
    begin
      addToSystemJournal('близко или далеко от следующий точки: ' + intToStr(dx) + ' ' + intToStr(dy));

      recompute := True;
      continue;
    end;
    
    // направление шага
    dir := CalcDir(PredictedX, PredictedY, path[idx].x, path[idx].y);
    
    if dir = 100 then
    begin
      addToSystemJournal('dir=100');
      recompute := True;
      continue;
    end;
    
    // поворот если надо
    if PredictedDirection <> dir then
      if not _Step(dir, run) then
      begin
        recompute := True;
        continue;
      end;
      
    // и шаг
    if not _Step(dir, run) then
    begin
      recompute := True;
      continue;
    end;
    
    // если есть Callback вызываем его, если он вернул False то закругляемся
    //if assigned(callback) and not callback(path[idx].x, path[idx].y) then exit;
    
    Inc(idx);
    // дошли до конца пути
    if idx >= cnt then
    begin
      dx := Integer(PredictedX) - Integer(path[idx-1].x);
      dy := Integer(PredictedY) - Integer(path[idx-1].y);
     
      // если подошли на правильное расстояние, то все - конец
      if (abs(dx) <= acc) and (abs(dy) <= acc) then 
      begin
        addToSystemJournal('на месте');
        result := True;
        break;
      end;
      
      // если же не пришли - считаем путь по новой
      addToSystemJournal('Конец маршрута, но мы далеко ' + intToStr(dx) + ' ' + intToStr(dy));

      recompute := True;
    end;
  end;
end;

 
end.

[sith_apprentice]

Buy&Eat include:

1. Ищет еду в бекпаке (~60 разных типов)
2. Ест до тех пор пока не получит "you can't eat any more"
3. Если еда в рюкзаке кончилась, покупает у вендора и снова ест
4. Если не наелся см. пункт 3 пока у вендора не кончится еда.

Использование:

Code: Select all

...
// встаем рядом с вендором Vasya

Buy_And_Eat(''); // или Buy_And_Eat('Vasya ');

Собственно скрипт:

(ЗЫ мне пришлось вставить переносы строк в FoodTypes чтобы пост отображался корректно)

Code: Select all

// Buy_and_Eat_v0_1 by sith_apprentice
// move your char close to the vendor and call
// Buy_And_Eat(VendorName:string);

// VendorName is the vendor's name __followed by a space__
// VendorName can be an empty string, then the shar just says "buy"

// the function knows ~60 different types of food

// the char will look for food in the backpack and if he is still able to
// eat after consuming it all will shop for more and eat whatever he bought 

const
	FoodBuyAtATime = 3; // buy 3 pieces of food of each type
	FoodPrice = 3; // maximum food price you are willing to pay
	StopEatingAtString = 'any more'; // if this text appears in the journal we are done eating
	NotEdibleString = 'think of'; // if this text appears in the journal the object is not edible. Fix the FoodTypes arrays.
	DelayEating = 4000;   // 4 seconds between eating pieces of food 
	DelayShopping = 3000;


function Buy_And_Eat(VendorName:string):boolean;
var // buys food at 3 gp and eats it
    ctime :TDateTime;
	FoodTypes :array of word; // store all the known food types here
  FoodTypesText :array of string;   // same but store them as strings for shoplist parsing functions
	i,k :integer;
	FoodID :cardinal; 
  	ShopList: TStringList;   
    SearchSubStr :string;
	BuyString:string; 
	
 // SilentModeSave :boolean;
begin
	AddToSystemJournal('Looking for some food...');
	Result := false;  
// set edible food types here
	FoodTypes := [$976,$977,$978,$979,$97B,$97C,$97D,$97E,$98E,$993,$994,$9B7,$9B8,$9BB,$9BC,$9C0,
$9C1,$9C9,$9D0,$9D1,$9D2,$9D3,$9E9,$9EA,$9EB,$9EC,$9F2,$9FA,$103B,$103C,$1040,$1041,
$15F9,$15FA,$15FB,$15FC,$15FE,$15FF,$1600,$1601,$1602,$1604,$1606,$1608,$160A,$160B,
$160C,$171D,$171E,$171F,$1720,$1721,$1722,$1723,$1724,$1725,$1726,$1727,$1728,$1729,
$172A,$172B,$172C,$172D]; // add more food types here. 
	FoodTypesText := ['$976','$977','$978','$979','$97B','$97C','$97D','$97E','$98E','$993','$994','$9B7','$9B8','$9BB','$9BC',
'$9C0','$9C1','$9C9','$9D0','$9D1','$9D2','$9D3','$9E9','$9EA','$9EB','$9EC','$9F2','$9FA','$103B',
'$103C','$1040','$1041','$15F9','$15FA','$15FB','$15FC','$15FE','$15FF','$1600','$1601','$1602',
'$1604','$1606','$1608','$160A','$160B','$160C','$171D','$171E','$171F','$1720','$1721','$1722',
'$1723','$1724','$1725','$1726','$1727','$1728','$1729','$172A','$172B','$172C','$172D']; 
// a nice example of ->(_!_)-> programming, especially when there is no sprintf;

	if (High(FoodTypes) <> High(FoodTypesText)) then begin
		// basic sanity check -- the lists should have the same length
		AddToSystemJournal('FoodTypes and FoodTypesText lists have different number of elements. Food shopping is not working.');
		Exit;
	end;
	
	// let's see if we already have food in our backpack:
  for i:=Low(FoodTypes) to High(FoodTypes) do
  begin
	FoodID := FindTypeEx(FoodTypes[i],$0000,Backpack,true);
	while (FoodID > 0) do
	begin  
		ctime := Now;
		AddToSystemJournal('Eating food, ID='+IntToStr(FoodID)); 
		UseObject(FoodID);
		Wait(DelayEating);
		if (InJournalBetweenTimes(StopEatingAtString,ctime,Now)>=0) then Exit; // we are stuffed, no more food needed
		if (InJournalBetweenTimes(NotEdibleString,ctime,Now)>=0) then 
		begin
			AddToSystemJournal('FIXME: Type '+FoodTypesText[i]+' is not edible!');
			break; // server does not believe it is edible
		end;
		FoodID := FindTypeEx(FoodTypes[i],$0000,Backpack,true); // search for a next piece of food
	end;
   end; 

// well it seems we are going to have to buy the food

//	moveOpenDoor := true;  // come to the guy who sells food
//	NewMoveXY(FoodX,FoodY,True,1,True);  
   
  //SilentModeSave := GetSilentMode(); //does not work
	SetSilentMode(false);
	BuyString := VendorName+'buy';
	UOSay(BuyString);  // talk to the guy selling the food
    Wait(DelayShopping);
	
	// see what the NPC is selling:
	ShopList:= TStringList.Create;   // save the previous silent mode status
    GetShopList(ShopList);
	//ShopList.AddStrings(GetShopList()); //does not work
    //AddToSystemJournal('Shop list length: '+IntToStr(ShopList.Count));
	for i:= 0 to ShopList.Count-1 do 
	begin
		for k:=Low(FoodTypesText) to High(FoodTypesText) do   
		begin
      SearchSubStr := '|type|'+FoodTypesText[k]+'|';  
      //AddToSystemJournal('Substring is '+SearchSubStr+', k='+IntToStr(k)+' i='+IntToStr(i));
			if (BMSearch(1,ShopList.Strings[i],SearchSubStr) > 0) then
			begin
				// found some known food for sale 
				AddToSystemJournal('Food found in store, type is '+FoodTypesText[k]+', buying...');
				AutoBuyEx(FoodTypes[k],$0000,FoodBuyAtATime,FoodPrice,'');
				// buy the picked food:
				UOSay(BuyString);   
				Wait(2*DelayShopping);     
        
				//eat whatever we just bought 
				FoodID := FindTypeEx(FoodTypes[k],$0000,Backpack,true);
				//AddToSystemJournal('Food ID is '+IntToStr(FoodID)); 
				while (FoodID > 0) do
				begin  
					ctime := Now;
					AddToSystemJournal('Eating food, ID='+IntToStr(FoodID)); 
					UseObject(FoodID);
					Wait(DelayEating);
					if (InJournalBetweenTimes(StopEatingAtString,ctime,Now)>=0) then Exit; // we are stuffed, no more food needed  
					if (InJournalBetweenTimes(NotEdibleString,ctime,Now)>=0) then 
					begin
						AddToSystemJournal('FIXME: Type '+FoodTypesText[k]+' is not edible!');
						break; // server does not believe it is edible
					end;
					FoodID := FindTypeEx(FoodTypes[k],$0000,Backpack,true); // search for a next piece of food
					//AddToSystemJournal('Food ID is '+IntToStr(FoodID)); 
				end;
			end;
		end;  
	end;
	ShopList.free;  
  ClearShopList(); // I really don't know what it does but I want to call it anyway
  //SetSilentMode(SilentModeSave); // does not work  // return the silent mode to whatever it was
  SetSilentMode(true);  
	
end;

[sith_apprentice]

Diffusive Lumber include

Features:

1. Автопоиск деревьев
2. Запоминает каждое уже срубленное дерево на указанное количество секунд
3. Генерирует код ошибки, если в процессе рубки что-то пошло не так

~100k логов срублено =)

Использование:

Code: Select all

{$Include 'gm_detect.pas'}
{$Include 'diff_lumber.pas'}

...
// пришли в лес
res := ChopTheTrees(сколько хотим дров);

// что получилось в результате рубки?

        case res of
		ChopTree_Done, ChopTree_TooHeavy:
                         // дрова нарублены
     ChopTree_Stuck, ChopTree_NoTrees, ChopTree_GuardZone :
                     // застрял, не могу найти деревья, забрел в ГЗ
		ChopTree_NoAxe:
                     // рубить нечем
		ChopTree_OMG_PK, ChopTree_OMG_GM:
                    // испугался ПК, ГМ
		ChopTree_UnderAttack:
                   // кто-то напал пока рубил
		ChopTree_Dead:
                  // не могу рубить потому что умер 
	end;

Сам файл:

Code: Select all

// Diffusive Lumber v0.1 by sith_apprentice

// In order to chop trees, you call 
// Status := ChopTheTrees(Number_Of_Logs_You_Want);
// it returns when it's done or when something interrupts it. 

// Status tells you exactly what happened:
//  ChopTree_Done - chopped the requested number of logs w/o problems
//  ChopTree_TooHeavy - can't carry any more
//  ChopTree_Stuck - you are stuck
//  ChopTree_NoAxe - nothing to chop it with 
//  ChopTree_OMG_PK - it's time to run or recall away 
//  ChopTree_NoTrees - there are no trees around  
//  ChopTree_Dead - can't chop trees because is dead :( 
//  ChopTree_UnderAttack - someone is attacking you
//  ChopTree_GuardZone - the server does not let you chop trees in GZ 
//  ChopTree_Disconnected - you cannot chop the trees because you are not logged in
//  ChopTree_OMG_GM - a GM is standing next to you


// ------------- configuration parameters ---------------
const 
  SpawnTime = 60*60;  // time it takes a tree to respawn = 60 minutes in seconds  
  ChopDelay = 3000; // wait 3s in between tree chopping
  MaxSearchDist=100;   // how far at max would the char look for the trees?
  MaxReachableDist=1; // how close do I have to be to a tree to chop it  
  BeAfraidOfBlueChars=True; // generate OMG_PK event when you see blue characters
  BluePeopleCreepyDistance=15; // generate OMG_PK event when blue characters come closer than this
// 15 is ~half of the screen size. Mb it's a thief?
  BeAfraidOfCritters=true; // generate OMG_PK events upon noticing Bladed spirits, elementals, etc

 
// if the tile ids are in this range we have a tree to chop 
  tts1=3274; // 1st id of the choppable tree tile #1
  tte1=3304; // last id of the choppable tree tile #1
  tts2=3320; // 1st id of the choppable tree tile #2
  tte2=3331; // last id of the choppable tree tile #2
  tts3=3476; // 1st id of the choppable tree tile #2
  tte3=3499; // last id of the choppable tree tile #3
  StopChoppingString='There are no|too far|of a way to use|line of sight|too heavy|cancelled|not here|immune|attacking you|frozen';
  TooHeavyString='too heavy'; 
  UnderAttackString='attacking you';
  NotHereString='not here|decide not to chop';
  AxeType=$0F43; // ID of whatever object you chop the trees with
  LogType=$1BDD;  // ID of logs
  TreesMaxCount=SpawnTime*1000/ChopDelay; //maximum number of chopped trees that are remembered. The formula does not require editing, just double check this is an integer.
  CantReachMax=5; // how many "you can't reach this" messages in the row you get before you realize you are stuck
  MinPermitted_HP_Fraction=0.8; // if your health drops below this fraction of maximum health the script realizes something went wrong and alerts you
	
// ---------- status constant refetence ------------
// don't edit this, just read so that you know what the script returns
// the possible results are:
Const
	ChopTree_Done=0; // chopped the requested number of logs w/o problems
	ChopTree_TooHeavy=1; // can't carry any more
	ChopTree_CantReach=2; // can't get to the tree, stuck
	ChopTree_Stuck=ChopTree_CantReach; // another name for the same thing 
	ChopTree_NoAxe=3; // nothing to chop it with 
  ChopTree_OMG_PK=4; // it's time to run or recall away 
  ChopTree_NoTrees=5; // there is no trees around  
  ChopTree_Dead=6; // can't chop trees because is dead :( 
  ChopTree_UnderAttack=7; // someone is attacking you
  ChopTree_GuardZone=8; // the server does not let you chop trees in GZ 
  ChopTree_Disconnected=9; // you cannot chop the trees because you are disconnected  
  ChopTree_OMG_GM=10;  // a GM wants something from you

// ------- the script starts here ----------

Var
  LastTreeTileFound :word; // what was the last tile type that matched with a tree type?
 
Type TTreeData = Record
  XY : Int64;
  time : Int64;  // time label, unix timestamp
  End; 

Var AlreadyChoppedTrees  :array [0..TreesMaxCount] of TTreeData; 
Var LastTreePtr :word;

function isTree(X,Y : word):boolean;  // returns true if there is a tree in this tile and false otherwise
Var
 staticsHere :TStaticCell;  
 cs :TStaticItem;
 k :Byte; 
Begin                       
  Result := false; // well, the vast majority of the game objects are not trees
  staticsHere := ReadStaticsXY(X,Y,WorldNum()); 
//  AddToSystemJournal('Checking a tile at X='+IntToStr(X)+', Y='+IntToStr(Y)+', statics total:'+IntToStr(staticsHere.StaticCount));  
  if (staticsHere.StaticCount > 0)  then
    for k := 0 to (staticsHere.StaticCount-1) do 
     begin             
        cs := staticsHere.Statics[k];   
  //      AddToSystemJournal('This tile has type:'+IntToStr(cs.Tile));
        if (((cs.Tile <= tte1) and (cs.Tile >= tts1)) or ((cs.Tile <= tte2) and (cs.Tile >= tts2)) or ((cs.Tile <= tte3) and (cs.Tile >= tts3))) then
          begin  
             Result := True; 
             LastTreeTileFound :=cs.Tile; 
             //AddToSystemJournal('This is a tree');    
             Exit;    // this one seem to work
          end;  
  end;  
// AddToSystemJournal('This is not a tree'); 
End;


function ChoppedItAlready(X,Y : word) : Boolean;
// outputs True if the tree is not ready yet, False otherwise
Var 
  XY :cardinal;
  i :word;
  ctime : Int64;
  ctree:TTreeData; 
begin
  ctime := DateTimeToUnix(Now);
  XY := (X shr 32) +Y; //  this is the tree's label for identification
  Result := false;
      
  for i:=0 to LastTreePtr do  
      begin  
        ctree:=AlreadyChoppedTrees[i];
        if (Abs(ctime-ctree.time)<SpawnTime) then 
        Begin
          if (XY = ctree.XY) then 
            Begin
            Result := True; //the tree is not ready yet
             Exit; 
           End; 
        End else AlreadyChoppedTrees[i].XY:=0; // this tree has respawned already
      End
end;

function LabelTheTree(X,Y : word) : Boolean;
// returns false all the time
Var 
    TreeWritten :boolean;
    i:word;
    ctime,XY :Int64; 
    ctree:TTreeData; 
Begin
    TreeWritten := False; 
    ctime := DateTimeToUnix(Now);
    XY := (X shr 32) +Y;     
          
    for i:=0 to LastTreePtr do 
    begin        
      ctree := AlreadyChoppedTrees[i]; // comparison doesn't work if I don't pick it out this way :/
      if (ctree.XY=0) then // reuse the free spot
         Begin
            ctree.Time := ctime;
            ctree.XY := XY;       
            AlreadyChoppedTrees[i]:=ctree;
            TreeWritten := True;   
            Exit;
         End;   
    end;
         
    if (not TreeWritten) then  // increase the array size and add the tree
    Begin 
        if (High(AlreadyChoppedTrees)=LastTreePtr) then
        begin
           // emergency memory request to remember more trees!!
           SetLength(AlreadyChoppedTrees,High(AlreadyChoppedTrees)+TreesMaxCount);
        end;
         
        LastTreePtr := LastTreePtr+1; 
        ctree.Time := ctime;     
        ctree.XY := XY; 
        AlreadyChoppedTrees[LastTreePtr] := ctree; 
    End;  
    Result := False; 
End;  

function isReachable(X,Y : word) : boolean;
// are we MaxRechableDistance tiles away or more?
Begin
   Result := True;
   if ((Abs(X-GetX(self)) > MaxReachableDist) or (Abs(Y-GetY(Self)) > MaxReachableDist)) then Result := False;
End;

function is_PK_Around():boolean; // returns True if you are in danger and False otherwise
Var 
  q,i:integer;  // based on nepopus' anti-PK
  FriendList:array of string; // not be afraid of these people
  HisName:string;
  ID:cardinal;
 begin
	FriendList := ['MyOtherChar1','MyOtherChar2','MyOtherChar3','MyOtherChar4'];
    Result := false;   
    FindDistance := 30;
    for q:=3 to 6 do
      if ((FindNotoriety($0190,q)>0) or (FindNotoriety($0191,q)>0)) then
      begin                                               
      // there is an evil man or woman ruinning around
        Result := true;    
        AddToSystemJournal('A PK is here! Run!! X='+IntToStr(GetX(Self))+', Y='+IntToStr(GetY(Self)));
        Exit; // run for your life!!
      end;   
      
    if (BeAfraidOfBlueChars) then 
    Begin  
      FindDistance := BluePeopleCreepyDistance; 
	  ID := FindNotoriety($0190,1);
	  if (not ID>0) then ID := FindNotoriety($0191,1);
      if (ID>0) then 
        begin  
		  HisName := GetName(ID);
		  for i:= Low(FriendList) to High(FriendList) do
			  if (BMSearch(1,Hisname,FriendList[i]) > 0) then
			  begin
				//false alarm, it's a friend
				Result := false;
				Exit;
			  end;
			  
          AddToSystemJournal('A creepy blue char wants something from you. X='+IntToStr(GetX(Self))+', Y='+IntToStr(GetY(Self)));
          Result:=true; // the blue char comes too close, probably up to no good
        end
    End;

// upd --  run away from Blade Spirits and other annoying critters that are killing me all the time:
	
	if (BeAfraidOfCritters) then
	begin
		AggressiveCritterTypes:=[$23E,$23D,$39,$7,$4B,$8,$9,$C,$D,$F,$1,$11,$26,$2,$15,$10,$28,$6,$1E,$20,$22,$23,$29,$3,$0,$2E];
		// $23E = bladed spirit
		// $23D = energy vortex
		// $39 =  wisp
		// $7 =  Kraken
		// $4B = Cyclop
		// $8 = daemon (unarmed)
		// $9 = daemon (with sword)
		// $C = air elemental
		// $D = earth elemental
		// $E = fire elemental
		// $F = water elemental
		// $1 = Ettin
		// $11 = ettin with hammer
		// $26 = Mongbat
		// $02 = Zombie
		// $15 = Gazer
		// $10 = Orc
		// $28 = Orc with club
		// $6 = Orc captain
		// ....
		
		for i:=Low(AggressiveCritterTypes) to High(AggressiveCritterTypes) do
			if (FindType(AggressiveCritterTypes[i],Ground) > 0) then
			begin
				Result := true;
				break;
			end;
	end;
end;

function isWounded():boolean;
// returns True if you are seriously wounded (HP is below MinPermitted_HP_Fraction*max_HP)
// and you should worry about not dying rather than chopping wood
begin
	if (HP <= MaxHP*MinPermitted_HP_Fraction) then 
	begin
		//AddToSystemJournal('You are loosing health, something must be attacking you!');
		Result := true;
	End else Result := false;
end;


function GoChopIt(X,Y : word): word;
// returns False when TooHeavy event happened and True otherwise
Var 
  MoveSuccess :boolean;
  ctime :TDateTime;
  myZ :word;
  doWait,pk_is_around,is_wounded,is_gm_looking :boolean;   
Begin
  Result := ChopTree_Done; // the return status. Will be changed if something bad happens   
  
  pk_is_around := is_PK_Around();
  if (pk_is_around) then
  begin
      Result := ChopTree_OMG_PK; 
      Exit;
  end;
  
  is_wounded := isWounded();
  
  if (is_wounded) then
  begin
	Result := ChopTree_UnderAttack; 
	Exit; 
  End;
  
  is_gm_looking := is_GM_around();
  
  if (is_gm_looking) then
  begin
	Result := ChopTree_OMG_GM; 
	Exit; 
  End;
  
  MoveSuccess := True;
  if (not isReachable(X,Y)) then MoveSuccess := NewMoveXY(X,Y,True,1,True); // run to the tile, stop within 1 tile                             
  if (MoveSuccess) then
  begin
      // so start chopping it 
      ctime := Now; 
      myZ := GetZ(Self);

      // equip the axe if not equipped yet
      if (GetType(ObjAtLayer(lhandLayer)) <> AxeType) then 
	begin
		equipt(lhandlayer,AxeType);
		wait(1000);
	end;
          
  
	if (GetType(ObjAtLayer(lhandLayer)) = AxeType) then // if we tried to equip the axt, check again if it is actually equipped
	  begin     
        doWait := false; // we don't need to wait the very first time we hit the tree
        
        If (not pk_is_around) then begin
			// the chopping cycle starts
    	      repeat  
				if (doWait) then wait(ChopDelay) else wait(500);
    	        UseObject(ObjAtLayer(lhandLayer));
				WaitTargetTile(LastTreeTileFound,X,Y,myZ); 
				doWait:= true; // we have to wait in between of hitting the trees  
				pk_is_around := is_PK_Around();
				is_wounded := isWounded();
				is_gm_looking := is_GM_around();
    	      until (is_gm_looking or pk_is_around or is_wounded or dead or (not Connected) or (InJournalBetweenTimes(StopChoppingString,ctime,Now)>=0)) 
     	     // the chopping cycle ends
 
			 // checking exactly why we stopped chopping trees: 
            if (InJournalBetweenTimes(NotHereString,ctime,Now)>=0)  then 
            begin        
              AddToSystemJournal('You wandered into a tree-chopping-free zone');
              Result := ChopTree_GuardZone;  
            end;
			
            if (InJournalBetweenTimes(TooHeavyString,ctime,Now)>=0)  then 
            begin 
              AddToSystemJournal('You cannot carry any more');
              Result := ChopTree_TooHeavy;           
            end;
			
            if ((InJournalBetweenTimes(UnderAttackString,ctime,Now)>=0) or is_wounded)  then 
            begin                   
              AddToSystemJournal('Someone is attacking you!');
              Result := ChopTree_UnderAttack;    
            end;
            
			if (pk_is_around) then Result := ChopTree_OMG_PK; 
			if (is_gm_looking) then Result := ChopTree_OMG_GM; 
                 
         end;
	  end 
    else Result := ChopTree_NoAxe; // we tried to equip the axe, but it didn't help 
      
  end else Result := ChopTree_CantReach;
  
  // mark the tree and forget about it until it regrows:
  LabelTheTree(X,Y);  
   
  if (dead) then Result := ChopTree_Dead;  
  if (not Connected) then Result := ChopTree_Disconnected;
end;


function ChopTheTrees(nmax:word): word;
Var 
  currSearchDist :word;
  srchX, srchY, myX,myY :word;
  TreeFound : boolean;  
  CantReachCount : byte; // how many "can't reach" messages 
  // you got in a row so far

begin
 currSearchDist := 0;
 TreeFound := false;  
 
 srchX := GetX(Self);  // initialize just in case
 srchY := GetY(Self);  
 
 
 Result := ChopTree_Done;   
 CantReachCount := 0;

    repeat  
        if (TreeFound) then 
          begin
            Result:=GoChopIt(srchX,srchY); 
            currSearchDist := 0;  
            
            if (Result=ChopTree_CantReach) then
            begin
              CantReachCount := CantReachCount+1;
              if (CantReachCount >= CantReachMax) then 
			  begin
			    AddToSystemJournal('You cant reach trees, you are stuck');
				Break; // we can't reach any trees, we are probably stuck or in jail or something
			  end;
            end else CantReachCount := 0;
              
            if (FindTypeEx(LogType,$0000,Backpack,True) >0 ) then // did we collect enough logs yet?
            begin         
             //AddToSystemJournal('You collected '+IntToStr(findQuantity)+' regular logs total');
             if (findQuantity >= nmax) then
             begin
                Result := ChopTree_Done; // we chopped enough logs and nothing bad happened!     
                Break;
             end;
            End;   
          end; 
        
        TreeFound:= false;
        myX := GetX(Self);
        myY := GetY(Self); 
        //AddToSystemJournal('I am at X='+IntToStr(myX)+' Y='+IntToStr(myY)+', looking for trees '+IntToStr(currSearchDist+1)+' tiles away from me...');
 
        currSearchDist := currSearchDist+1;
        if (currSearchDist > MaxSearchDist) then break; // there are no trees within reach :(  
        
        srchY := myY-currSearchDist; // search along a line on the top
        for srchX := myX-currSearchDist to myX+currSearchDist-1 do
          begin
            if (isTree(srchX,srchY) and (not ChoppedItAlready(srchX,srchY))) then 
            begin
              TreeFound := True;   
              break;  
            end;
          end;
               
        if (TreeFound) then continue;   
        
        srchX := myX-currSearchDist; // search along a line on the left
        for srchY := myY-currSearchDist to myY+currSearchDist-1 do
          begin
            if (isTree(srchX,srchY) and (not ChoppedItAlready(srchX,srchY))) then       
            begin
              TreeFound := True;   
              break; 
            end;
          end;
               
        if (TreeFound) then continue;  
        
        srchY := myY+currSearchDist; // search along a line on the bottom
        for srchX := myX-currSearchDist+1 to myX+currSearchDist do
          begin
            if (isTree(srchX,srchY) and (not ChoppedItAlready(srchX,srchY))) then 
            begin
              TreeFound := True;   
              break; 
            end;
          end;
               
        if (TreeFound) then continue;   
        
        srchX := myX+currSearchDist; // search along a line on the right
        for srchY := myY-currSearchDist+1 to myY+currSearchDist do
          begin
            if (isTree(srchX,srchY) and (not ChoppedItAlready(srchX,srchY))) then 
            begin
              TreeFound := True;   
              break; 
            end;
          end;
        
    until (Dead or (Result = ChopTree_TooHeavy) or (Result = ChopTree_OMG_PK) or (Result = ChopTree_Disconnected) or (Result = ChopTree_UnderAttack) or (Result = ChopTree_GuardZone)); 
  
// things that could happen according to their priority:  
    if (currSearchDist > MaxSearchDist)  then Result := ChopTree_NoTrees;
    if (dead) then Result := ChopTree_Dead; 
    if (not Connected) then Result := ChopTree_Disconnected;
end;

GM-detect include:

Code: Select all

// GM detect v0.1 by sith_apprentice
//
// Part of Diffusive Lumber script
// tries to determine if a GM is nearby or not
// we are going to have to assume that we only meet a single person it a middle of the forest at a time	

// configure GM_name_contains := ... line
// if a substring in the character's name you see name matches this set the script assumes
// that you met a game master

// interface: 

// is_GM_around():boolean;
// this function checks if there is a character around you that is a GM
// returns True if such a character is found and false otherwise

// (this is a private function at the moment)
// does_GM_name_match(ID:cardinal):boolean;
// checks if the name of the character with this ID matches the GM_name_contains array
// returns True if it does, False otherwise
// this function is called by is_GM_around() for people found around you

//Unit GM_detect_v0_1;

//interface

//function is_GM_around():boolean;

//implementation


Var
	GM_name_contains :array of string; // general prefixes+official abyss staff
		

function does_GM_name_match(ID:cardinal):boolean;
var
	HisName:String;
	i:integer;
begin
	HisName := GetName(ID); 
  GM_name_contains := ['GM','Seer', 'Counselor', 'Helper', 'Administrator', 'Admin','GM_name1', 'GM_name2', 'GM_name3', 'GM_name4'];
	For i:= Low(GM_name_contains) to High(GM_name_contains) do
	begin
		if (BMSearch(1,HisName,GM_name_contains[i])>0) then
		begin
		// the name of the character mached with one of known GM names
			AddToSystemJournal('Well shit a GM has spotted you');
			Result := true;
			Exit;
		end;
	end;
	Result := false;
end;
 
function is_GM_around():boolean;
var
	GM_ID :Cardinal;
begin
	FindDistance := 30;
	
	GM_ID := FindType($0190, Ground);  // looking for a male GM
	
	if (GM_ID >0) then
		if (does_GM_name_match(GM_ID)) then
		begin
			Result := true;
			Exit;
		end;

	GM_ID := FindType($0191, Ground);	// looking for a female GM
		
	if (GM_ID >0) then
		if (does_GM_name_match(GM_ID)) then
		begin
			Result := true;
			Exit;
		end;
		
	// phew, no GMs around. Keep working :)
	
	Result := false;
end;

//end.

[aalexx]

А где есть данный инклюд - diff_lumber.pas ??

[sith_apprentice]

Всмысле?

Весь кусок который начинается с

Code: Select all

// Diffusive Lumber v0.1 by sith_apprentice
....

и есть diff_lumber.pas

[aalexx]

Ok, благодарю! Приду с работы - попробую -)