Просмотр полной версии : Макрос на Lumberjacking
Не прошло и недели :) - наконец-то я родил первую рабочую альфу скрипта (для UOScript) на lumberjack, хотелось бы посмотреть примеры знающих толк в скриптовании людей, дабы впредь не создавать таких монстрообразных конструкций. Пожалуйста не обойдите вниманием господа скриптеры.
Задавай вопросы. А лучше в асю.
b - ограничитель радиуса поиска деревьев
Program Lamberjacking_alpha_04;
var
MyList, MyCount, ItemIndex, a, b, i: longint;
CharX, CharY, iX, iY, LocX, LocY, LocZ: word;
ItemType: word;
MSG, MSGL: string;
begin
GetStaticObjectsList(MyList);//Получаем список
GetListCount(MyList, MyCount);//Значение для счётчика
a:=0;
b:=10;//зону поиска ставлю 10, хочется мне так
CharX:=_posx;
CharY:=_posy;
repeat
GetListItem(MyList, a, ItemIndex, MSG);
GetStaticObjectInfo(ItemIndex, ItemType, LocX, LocY, LocZ);
if
((LocX >= (CharX - b)) and
(LocX <= (CharX + b)) and
(LocY >= (CharY - b)) and
(LocY <= (CharY + b))) Then //поехал цикл, если штука - дерево
begin
if
((IntToHex(ItemType, 4) = '0CD3') or
(IntToHex(ItemType, 4) = '0CD6') or
(IntToHex(ItemType, 4) = '0CD8') or
(IntToHex(ItemType, 4) = '0CDA') or
(IntToHex(ItemType, 4) = '0CDD') or
(IntToHex(ItemType, 4) = '0CE0') or
(IntToHex(ItemType, 4) = '0CE3') or
(IntToHex(ItemType, 4) = '0CE6') or
(IntToHex(ItemType, 4) = '0CF8') or
(IntToHex(ItemType, 4) = '0CFB') or
(IntToHex(ItemType, 4) = '0CFE') or
(IntToHex(ItemType, 4) = '0D01') or
(IntToHex(ItemType, 4) = '0D41') or
(IntToHex(ItemType, 4) = '0D42') or
(IntToHex(ItemType, 4) = '0D43') or
(IntToHex(ItemType, 4) = '0D44') or
(IntToHex(ItemType, 4) = '0D84') or
(IntToHex(ItemType, 4) = '0D85') or
(IntToHex(ItemType, 4) = '0D86'))
Then
begin
i:=0;
LocX:=LocX-1;
LocY:=LocY+1;
repeat //запускаем цикл на движение
CharX:=_posx;
CharY:=_posy;
if ((CharX > LocX) and (CharY > LocY)) Then
begin
sendkey(k_Up);
MSG:='Up';
Delay(500);
end
else if ((CharX = LocX) and (CharY > LocY)) Then
begin
sendkey(k_PgUp);
MSG:='RightUp';
Delay(500);
end
else if ((CharX < LocX) and (CharY < LocY)) Then
begin
sendkey(k_Down);
MSG:='Down';
Delay(500);
end
else if ((CharX = LocX) and (CharY < LocY)) Then
begin
sendkey(k_End);
MSG:='LeftDown';
Delay(500);
end
else if ((CharX < LocX) and (CharY > LocY)) Then
begin
sendkey(k_Right);
MSG:='Right';
Delay(500);
end
else if ((CharX < LocX) and (CharY = LocY)) Then
begin
sendkey(k_PgDown);
MSG:='RightDown';
Delay(500);
end
else if ((CharX > LocX) and (CharY < LocY)) Then
begin
sendkey(k_Left);
MSG:='Left';
Delay(500);
end
else if ((CharX > LocX) and (CharY = LocY)) Then
begin
sendkey(k_Home);
MSG:='LeftUp';
Delay(500);
end;
iX := _posx;
iY := _posy;
if ((iX = CharX) and (iY = CharY)) then
begin
i := i + 1;
if (i = 6) Then
begin
CharX:=_posx;
CharY:=_posy;
if
((CharX >= (LocX - 1)) and
(CharX <= (LocX + 1)) and
(CharY >= (LocY - 1)) and
(CharY <= (LocY + 1))) Then
begin
break; //если не меняется координата и точка нахождения соседняя с конечной - обрываем цикл и занимаемся следующим деревом
// Exit;
end
else
begin
if (MSG = 'Up') Then
begin
RightDoubleClick(400,200);
Delay(5000);
end
else if (MSG = 'RightUp') Then
begin
RightDoubleClick(500,200);
Delay(5000);
end
else if (MSG = 'LeftUp') Then
begin
RightDoubleClick(300,200);
Delay(5000);
end
else if (MSG = 'Down') Then
begin
RightDoubleClick(400,400);
Delay(5000);
end
else if (MSG = 'LeftDown') Then
begin
RightDoubleClick(300,400);
Delay(5000);
end
else if (MSG = 'RightDown') Then
begin
RightDoubleClick(500,400);
Delay(5000);
end
else if (MSG = 'Left') Then
begin
RightDoubleClick(300,300);
Delay(5000);
end
else if (MSG = 'Right') Then
begin
RightDoubleClick(500,300);
Delay(5000);
end;
i := 0;
end;//иначе используем двойной правый клик в направлении последнего смещения для обхода препятствия
end;
end;
Until ((CharX = LocX) and (CharY = LocY));
begin //рубим дерево во всю
sendkey(k_Insert);
waitfortarget(3000);
LeftClick(436,286);
Delay(1000);
MSGL:=_lastmsg;
If
((Pos('there are no', MSGL)=0) and
(Pos('chopping the tree', MSGL)=0) and
(Pos('you can', MSGL)=0) and
(Pos('that is too', MSGL)=0) and
(Pos('it appears immune', MSGL)=0)) Then
begin
Delay(8000);
Repeat
SendKey(k_Delete);
Delay(10000);
MSGL:=_lastmsg;
Until ((Pos('there are no', MSGL)<>0) or
(Pos('chopping the tree', MSGL)<>0) or
(Pos('you can', MSGL)<>0) or
(Pos('that is too', MSGL)<>0) or
(Pos('it appears immune', MSGL)<>0));
end;
end;
end;
end;
a := a+1;
Until (a > MyCount);
FreeObjectsList(MyList);
end.
Как нет обхода препятствия? Вот же оно! *тыкает пальчиком*
Нет самого интерестного... Обхода препядствий :)
Стукни лудче мне в аську 122907
Процедура поиска деревьев.
procedure TreeSearch;
var
aTreeName: String;
dR, dRmin: Extended;
begin
GetStaticObjectsList(aList);
GetListCount(aList, k);
dRmin:=1000;
For i:=0 to k-1 do // пробегаюсь по списку
begin
GetListItem(aList, i, aTreeHandle, aTreeName); // получаю список итемов
GetStaticObjectInfo(aTreeHandle, aTreeType, Xmine,Ymine,Zmine); // получаю инфо и координаты первого дерева
If (aTreeType=TreeType) or (aTreeType=TreeType2) or (aTreeType=TreeType3) or (aTreeType=TreeType4) or (aTreeType=TreeType5) or (aTreeType=TreeType6) or (aTreeType=TreeType7) or (aTreeType=TreeType8) or (aTreeType=TreeType9) or (aTreeType=TreeType10) or (aTreeType=TreeType11) or (aTreeType=TreeType12) or (aTreeType=TreeType13) then // если тип равен типу дерева то.. бегин
begin
dR:=Sqrt((_posx-Xmine)*(_posx-Xmine)+(_posy-Ymine)*(_posy-Ymine)); // высчитвается минимальная дистанция..
If dR<dRmin Then // если расстояние до текущего дерева меньше
begin
If not SectionExists('D:\GAMES\UOaos\UOScriptOE\Lumber\tr ee.ini', IntToStr(Xmine)+'_'+IntToStr(Ymine)) Then
begin
aTreeTypeMin:=aTreeType;
Xmin:=Xmine; // запоминаешь координаты этого дерева
Ymin:=Ymine;
Zmin:=Zmine;
dRmin:=dR; // запоминаешь последнее минимальное расстояние
end;
end;
end;
end;
end;
Это было чистым скриптом на движение, нужно чтобы LocX, LocY принимались из вне.
ЗЫ: г-н Baal распугал всех скриптеров... :)
Program Moving_beta_06;
var
i: longint;
CharX, CharY, LocX, LocY, iX, iY: word;
ItemType: word;
MSG: string;
begin
i:=0;
LocX:=2400;
LocY:=600;
repeat
CharX:=_posx;
CharY:=_posy;
if ((CharX > LocX) and (CharY > LocY)) Then
begin
sendkey(k_Up);
MSG:='Up';
Delay(500);
end
else if ((CharX = LocX) and (CharY > LocY)) Then
begin
sendkey(k_PgUp);
MSG:='RightUp';
Delay(500);
end
else if ((CharX < LocX) and (CharY < LocY)) Then
begin
sendkey(k_Down);
MSG:='Down';
Delay(500);
end
else if ((CharX = LocX) and (CharY < LocY)) Then
begin
sendkey(k_End);
MSG:='LeftDown';
Delay(500);
end
else if ((CharX < LocX) and (CharY > LocY)) Then
begin
sendkey(k_Right);
MSG:='Right';
Delay(500);
end
else if ((CharX < LocX) and (CharY = LocY)) Then
begin
sendkey(k_PgDown);
MSG:='RightDown';
Delay(500);
end
else if ((CharX > LocX) and (CharY < LocY)) Then
begin
sendkey(k_Left);
MSG:='Left';
Delay(500);
end
else if ((CharX > LocX) and (CharY = LocY)) Then
begin
sendkey(k_Home);
MSG:='LeftUp';
Delay(500);
end;
iX := _posx;
iY := _posy;
if ((iX = CharX) and (iY = CharY)) then
begin
i := i + 1;
if (i = 6) Then
begin
CharX:=_posx;
CharY:=_posy;
if
((CharX >= (LocX - 1)) and
(CharX <= (LocX + 1)) and
(CharY >= (LocY - 1)) and
(CharY <= (LocY + 1))) Then
begin
Exit;
end
else
begin
if (MSG = 'Up') Then
begin
RightDoubleClick(400,200);
Delay(5000);
end
else if (MSG = 'RightUp') Then
begin
RightDoubleClick(500,200);
Delay(5000);
end
else if (MSG = 'LeftUp') Then
begin
RightDoubleClick(300,200);
Delay(5000);
end
else if (MSG = 'Down') Then
begin
RightDoubleClick(400,400);
Delay(5000);
end
else if (MSG = 'LeftDown') Then
begin
RightDoubleClick(300,400);
Delay(5000);
end
else if (MSG = 'RightDown') Then
begin
RightDoubleClick(500,400);
Delay(5000);
end
else if (MSG = 'Left') Then
begin
RightDoubleClick(300,300);
Delay(5000);
end
else if (MSG = 'Right') Then
begin
RightDoubleClick(500,300);
Delay(5000);
end;
i := 0;
end;
end;
Until ((CharX = LocX) and (CharY = LocY));
end.
Alex M.A.
06.05.2004, 14:22
функция получения клавиши перемещения в зависимости от положения чара и точки куда ему нужно переместиться
function GetDirectionKey(xn, yn: LongInt; var aDir: LongInt): String;
var xt, yt: LongInt;
xd, yd: Integer;
begin
xt:=_posx;
yt:=_posy;
If xn<xt Then xd:=2;
If xn>xt Then xd:=1;
If xn=xt Then xd:=0;
If yn<yt Then yd:=2;
If yn>yt Then yd:=1;
If yn=yt Then yd:=0;
Case xd of
2: Case yd of
2: Result:=k_Up;
0: Result:=k_Home;
1: Result:=k_Left;
end;
0: Case yd of
2: Result:=k_PgUp;
0: Result:=#0;
1: Result:=k_End;
end;
1: Case yd of
2: Result:=k_Right;
0: Result:=k_PgDown;
1: Result:=k_Down;
end;
end;
Case Result of
k_PgUp: aDir:=dir_North;
k_Right: aDir:=dir_Northeast;
k_PgDown: aDir:=dir_East;
k_Down: aDir:=dir_Southeast;
k_End: aDir:=dir_South;
k_Left: aDir:=dir_Southwest;
k_Home: aDir:=dir_West;
k_Up: aDir:=dir_Northwest;
Else aDir:=dir_Unknown;
end;
end;
функция перемещения чара в точку с координатами xn, yn...
aWait максимальное время (в миллисекундах) ожидания завершения одного шага...
если чар не сделает ни одного шага за aWait*10 (лаг или чар уперся в препятствие), то функция завершается и возвращает False... в противном случае чар топает до конца и функция возвращает True...
обход препятствий не задействован...
function MoveTo(xn, yn: LongInt; aWait: LongInt): Boolean;
var st: String;
xo, yo: Word;
aDir, cDir, lpx, lpy: LongInt;
i: Integer;
wr: LongInt;
begin
wr:=0;
Repeat
st:=GetDirectionKey(xn, yn, aDir);
xo:=_posx; yo:=_posy;
cDir:=_dir;
If (aDir<>dir_Unknown) and (cDir<>dir_Unknown) Then
If aDir<>cDir Then
begin
SendKey(st);
Delay(200);
end;
SendKey(st);
i:=0;
Repeat
Delay(200);
i:=i+200;
Until (_posx<>xo) or (_posy<>yo) or (i>=aWait);
If i>=aWait Then wr:=wr+1
Else wr:=0;
Until ((_posx=xn) and (_posy=yn)) or (wr>10);
Result:=wr<=10;
end;
Огромное спасибо Zulo, спасибо Алексей, хотя ответы на вопросы по большей части были получены вне топа, однако они были весьма исчерпывающими. Последний вопрос к Алексею, не писали ли вы функции (допустим движения, хотя это не принципиально) в которой абсолютные координаты (координаты в мире) переводились бы в относительные (те которые 800х600 или 640х480) ? Изначально я пытался что-то такое написать для движения, но слишком велика погрешность, код не сохранился, но основная мысль была в том, что при 800х600 размер экрана составляет 18 и 12 шагов соответсвенно, т.е. считалась разность координат персонажа и точки следования (или наоборот если на выходе получалось отрицательное число), вообщем проще набить наверное будет:
[ломает с самого начала набивать]
if (LocX > CharX) Then
begin
MyX:=LocX-CharX;
XX:=XX+MyX*54;//54 - примерная длинна шага по Х
XY:=XY+MyX*38;
if (LocY > CharY) Then
begin
MyY:=LocY-CharY;
YX:=YX-MyY*54;
YY:=YY+MyY*38;
end
else if (LocY < CharY) Then
begin
MyY:=CharY-LocY;
YX:=YX+MyY*54;
YY:=YY-MyY*38;
end
[и так далее в том же духе]
end
a:= (XX + YX)/2;
b:= (XY + YY)/2;
doubleRightClick(a,b);
[пальцы не казённые]
не знаю, сможете ли вы разобраться в написанном, однако смысл в том, что относительные координаты переворачиваются (так чтобы оси Х и У были направленны также как направлены оси абсолютных координат) после чего считается среднее значение точки и туда делается райт даблл клик. Удовлетворительно работает только в пределах шага от персонажа, чем дальше тем выше вероятность ошибки. В принципе конечно можно использовать, но придётся писать слишком сложные, я бы даже сказал изощрённые, проверки на устоновку чаром ручника в положение "вкл".
Так вот, Алексей, вы не писали чего-нибудь к этому относимого?
Alex M.A.
06.05.2004, 15:44
нет... с использованием Pathfinding не писал... есть много других способов заставить чара ходить туда, куда надо...
но по просьбе одного человека, решившего сделать именно так, ввел в свое время в скриптер все гамму тригонометрических функций для преобразования координат... чем закончилась его попытка - не знаю...
Огромный респект!
Тока я ненашел что под что биндить...
на всякий:
Insert - Last object
Delete - last object, last target.
Вопрос у меня есть.... можно ли этот скрипт под майнинг замутить? а если можно то как! заранее великий сенкс!
Oraculino
01.06.2004, 06:57
на какой лучше ставить пилот?
Вообще-то изложенные выше макросы не на пилот, а на уоскрипт.
Будьте аккуратнее, предупреждение за флуд.
Powered by vBulletin™ Version 4.0.3 Copyright © 2024 vBulletin Solutions, Inc. All rights reserved. Перевод: zCarot