1. Из логов крафтим доски, скилл не растет
2. Из досок крафтим бумагу (в паке должно быть корыто с водой), бумага не складывается в стопки.
3. Из бумаги и ткани крафтятся partchments, причем у них такой же тип и цвет как у бумаги. В стопки не складываются.
4. Из partchments крафтятся бланкскроллы.
Плюс ко всему для пункта 3 для крафта нужен больший скилл, нежели для 2, для 4 - больший, нежели для 3.
К тому же на шарде глючат меню крафта, очень часто проскакивают ошибки и крафтится совсем не то, что заказывали.
Но на шарде есть команда .makelast для повтора предыдущего крафта.
Вот мое решение всех этих проблем:
Потребуется: в пак пилу, корыто с водой. Под ноги чару кучу логов и ткани. Рядом с чаром два сундука или ящика, в первый - кучу пустых мешков.
Весь крафт состоит из нескольких скриптов, объединять лень. Запускайте их по очереди, каждый на денек-другой.
ЭТАП 1. Крафтим доски.
Code: Select all
Program Carpentry1UP;
// v.1.02b (c) Edred
{$Include 'all.inc'}
// 1 этап. Из логов делаем доски.
// 2 этап. Из досок делаем бумагу. В паке должен быть water trough
// 3 этап (с 20.7 скилла). Из бумаги и folded cloth делаем Parchment
// 4 этап (с 25.7 скилла). Из parchment делаем Blank Scroll
var
ctime : TDateTime;
k : integer;
b : integer;
OldSkill : Double;
const
ToolsType = $1034; // saw
TypBoards = $1BD7; // Тип досок
CountLogsForBoard = 20;
HowGetLogs = 100;
HowDropBoards = 20;
TypLogs = $1BDD;
TrashID = $4005198D;
procedure CheckLogs;
begin
waitconnection(5000);
If Count(TypLogs) < CountLogsForBoard then
begin
FindType(TypLogs, ground);
if FindCount > 0 then
begin
k := FindQuantity;
Grab( FindItem, HowGetLogs );
wait(1000);
checksave;
Addtosystemjournal('Взял еще ' + inttostr(HowGetLogs) + ' логов из ' + inttostr(k));
end
else
begin
Addtosystemjournal('Нет логов на полу, добавьте');
repeat
wait(1000);
findtype(TypLogs, ground)
until FindCount > 0;
k := FindQuantity;
Grab(FindItem, HowGetLogs);
wait(1000);
checksave;
Addtosystemjournal('Взял еще ' + inttostr(HowGetLogs) + ' логов из ' + inttostr(k));
end;
end;
end;
procedure CheckBoards;
begin
waitconnection(5000);
If Count(TypBoards) > (HowDropBoards - 1) then
begin
b := Count(TypBoards);
FindType(TypBoards, backpack);
while FindCount > 0 do
begin
Drop(FindItem, 0, 0, 0, 0);
wait(1000);
checksave;
Addtosystemjournal('Сбросил ' + inttostr(b) + ' досок');
FindType(TypBoards, backpack);
end;
end;
end;
Begin
FindDistance := 2;
OldSkill := GetSkillValue('Carpentry');
CancelMenu;
AutoMenu('Carpentry', 'boards');
// Первый раз через меню
CheckLogs;
findtype(ToolsType, backpack);
if FindCount > 0 then
begin
ctime := Now;
k := 0;
UseObject( FindItem );
repeat
wait(100);
k := k + 1;
checksave;
until (InJournalBetweenTimes('You put|failed.', ctime, Now)<>-1) or (k > 200);
CheckBoards;
end;
// Теперь через makelast
repeat
CheckLogs;
findtype(ToolsType, backpack);
if FindCount > 0 then
begin
ctime := Now;
k := 0;
UOSay('.makelast');
repeat
wait(100);
k := k + 1;
checksave;
until (InJournalBetweenTimes('You put|failed.', ctime, Now)<>-1) or (k > 200);
CheckBoards;
end
else
begin
repeat
waitconnection(5000);
findtype(ToolsType, ground);
if FindCount > 0 then
begin
Grab( FindItem, 0 );
wait(1000);
checksave;
end
else
begin
Addtosystemjournal('Нет инструментов в паке, киньте на пол');
repeat
wait(1000);
findtype(ToolsType, ground);
until (FindCount > 0);
Grab( FindItem, 0 );
wait(1000);
checksave;
end;
until (Count(ToolsType) > 0);
end;
if GetSkillValue('Carpentry') > OldSkill then
begin
AddToSystemJournal('Скилл Carpentry вырос. Теперь он равен ' + FloatToStr(GetSkillValue('Carpentry')));
OldSkill := GetSkillValue('Carpentry');
end;
until GetSkillValue('Carpentry') >= 100.0;
End.
Code: Select all
Program Carpentry2UP;
// v.1.00b (c) Edred
{$Include 'all.inc'}
// 1 этап. Из логов делаем доски.
// 2 этап. Из досок делаем бумагу. В паке должен быть water trough
// 3 этап (с 20.7 скилла). Из бумаги и folded cloth делаем Parchment
// 4 этап (с 25.7 скилла). Из parchment делаем Blank Scroll
var
ctime : TDateTime;
LastContOpen : TDateTime;
k, s, m : integer;
curbag : cardinal;
FirstTime : boolean;
OldSkill : Double;
const
WhatYouDo = 'Paper'; // можно написать, например: '(last)'
TypBoards = $1BD7; // Тип досок
TypPaper = $1F24;
CountBoards = 5;
HowGetBoards = 100;
HowDropPapers = 20;
TrashID = $4005198D;
SundukEmptyBag = $40053D27; // тут лежат пустые мешки
Sunduk2Craft = $40053D34; // сюда кладем скрафченное
BagType = $0E76;
ToolsType = $1034; // saw
procedure OpenContainer(f : boolean);
// если f - true - просто открываем все нужные контейнеры, то есть:
// SundukIngots,SundukEmptyBag,Sunduk2Craft и curbag (если он не равен 0)
// если f - false - проверяем, был ли реконнект чара после последнего
// открывания контейнеров, если был - переоткрываем контейнеры и записываем
// новое значение в переменную LastContOpen, если не был - ничего не делаем
begin
waitconnection(3000);
if (f = true) or (LastContOpen < ConnectedTime) then
begin
UseObject(SundukEmptyBag);
wait(1000);
checksave;
UseObject(Sunduk2Craft);
wait(1000);
checksave;
if curbag <> 0 then
begin
UseObject(curbag);
wait(1000);
checksave;
end;
LastContOpen := Now;
addtosystemjournal('Контейнеры открыты в ' + DateTimeToStr(Now));
end;
end;
function GetEmptyBag : cardinal;
// берет пустой мешок из одного контейнера и помещает в другой
// возвращает сериал пустого мешка
var tmp1 : cardinal;
begin
Result := 0;
waitconnection(3000);
tmp1 := FindType(BagType,SundukEmptyBag);
if tmp1 = 0 then
begin
Addtosystemjournal('Error: кончились мешки');
exit;
end;
MoveItem(tmp1,1,Sunduk2Craft,0,0,0);
wait(1000);
CheckSave;
UseObject(tmp1);
wait(1000);
CheckSave;
Result := tmp1;
Addtosystemjournal('Взял новый мешок');
end;
function CheckCountPaper : Boolean;
begin
Result := False;
findtype(TypPaper,curbag);
if findcount > 250 then exit;
Result := True;
end;
function GetRes : boolean;
begin
Result := True;
if Count(TypBoards) < CountBoards then
begin
waitconnection(3000);
findtype(TypBoards,ground);
if GetQuantity(Finditem) < HowGetBoards then
begin
repeat
addtosystemjournal('Warning: Мало досок на полу');
wait(10000);
findtype(TypBoards,ground);
until GetQuantity(Finditem) >= HowGetBoards;
end;
m := GetQuantity(finditem);
Grab(FindItem,HowGetBoards);
wait(1000);
checksave;
addtosystemjournal('Взял ' + inttostr(HowGetBoards) + ' boards из ' + inttostr(m));
end;
end;
procedure DropPapers(a : integer);
var tmp1 : cardinal;
tmp2, tmp3 : Integer;
begin
waitconnection(3000);
if Count(TypPaper) < HowDropPapers then exit;
tmp3 := 0;
tmp1 := findtype(TypPaper,backpack);
while findcount > 0 do
begin
OpenContainer(false);
if not CheckCountPaper then curbag := GetEmptyBag;
tmp2 := GetQuantity(tmp1);
MoveItem(tmp1,tmp2,curbag,0,0,0);
wait(500);
checksave;
tmp3 := tmp3 + 1;
tmp1 := findtype(TypPaper,backpack);
end;
addtosystemjournal('Сбросил ' + inttostr(tmp3) + ' Papers. Всего скрафчено ' + inttostr(a));
end;
Begin
FindDistance := 2;
s := 0;
CancelMenu;
AutoMenu('Carpentry', WhatYouDo);
FirstTime := true;
// Первый раз через меню
LastContOpen := Now;
OpenContainer(true);
curbag := GetEmptyBag;
OldSkill := GetSkillValue('Carpentry');
repeat
if not GetRes then exit;
waitconnection(3000);
ctime := Now;
k := 0;
if FirstTime then
begin
if TargetPresent then CancelTarget;
UseType(ToolsType, $FFFF);
FirstTime := false;
end
else UOSay('.makelast');
repeat
wait(100);
k := k + 1;
checksave;
until (InJournalBetweenTimes('You put|You fail', ctime, Now)<>-1) or (k > 200);
if InJournalBetweenTimes('You put', ctime, Now)<>-1 then s := s + 1;
wait(2000)
DropPapers(s);
if GetSkillValue('Carpentry') > OldSkill then
begin
AddToSystemJournal('Скилл Carpentry вырос. Теперь он равен ' + FloatToStr(GetSkillValue('Carpentry')));
OldSkill := GetSkillValue('Carpentry');
end;
until GetSkillValue('Carpentry') >= 100.0;
End.
Code: Select all
Program Carpentry3UP;
// v.2.00b (c) Edred
{$Include 'all.inc'}
// 3 этап (с 20.7 скилла). Из бумаги и folded cloth делаем Parchment
// 4 этап (с 25.7 скилла). Из parchment делаем Blank Scroll
// Новый алгоритм:
//1. Функция поиска в сундуке мешка с бумагой, взять его в пак, открыть
//2. Пока в этом мешке есть бумага делай:
//3. Проверить есть ли ткань, взять 50
//4. Крафт партчментов, проверка на 'You put' и таймер на 15 сек. Первый крафт через меню,
// последующие через .makelast
//5. Когда бумага кончилась в мешке, делаем:
//6. Пока в паке есть партчменты, делай:
//7. Крафтим бланкскроллы, первый крафт через меню, последующие через .makelast
//8. Когда партчментов нет, скидываем бланки на пол и пустой мешок в первый сундук
var
ctime : TDateTime;
LastContOpen : TDateTime;
k : integer;
curbag : cardinal;
OldSkill : Double;
FirstTime : Boolean;
const
WhatYouDo = 'Parchment'; // можно написать, например: '(last)'
WhatYouDo2 = 'blank scroll';
TypPaper = $1F24;
TypScroll = $0E34;
TypCloth = $175D;
MinCloth = 1;
MaxCloth = 50;
MinPapers = 1;
MaxPapers = 1;
HowDropScroll = 20;
SundukEmptyBag = $40053D27; // тут лежат пустые мешки
Sunduk2Craft = $40053D34; // сюда кладем скрафченное
BagType = $0E76;
ToolsType = $1034; // saw
procedure OpenContainer(f : boolean);
// если f - true - просто открываем все нужные контейнеры, то есть:
// SundukIngots,SundukEmptyBag,Sunduk2Craft и curbag (если он не равен 0)
// если f - false - проверяем, был ли реконнект чара после последнего
// открывания контейнеров, если был - переоткрываем контейнеры и записываем
// новое значение в переменную LastContOpen, если не был - ничего не делаем
begin
waitconnection(3000);
if (f = true) or (LastContOpen < ConnectedTime) then
begin
UseObject(Sunduk2Craft);
wait(1000);
checksave;
if curbag <> 0 then
begin
UseObject(curbag);
wait(1000);
checksave;
end;
LastContOpen := Now;
addtosystemjournal('Контейнеры открыты в ' + DateTimeToStr(Now));
end;
end;
function FindBagWithPapers : Cardinal;
var tmpid : Cardinal;
tmpflag : Boolean;
begin
Result := 0;
repeat
waitconnection(3000);
tmpid := Findtype(BagType,Sunduk2Craft)
if tmpid = 0 then exit;
UseObject(tmpid);
wait(1000);
checksave;
if CountEx(TypPaper,$FFFF,tmpid) > 0 then
begin
waitconnection(3000);
repeat
tmpflag := MoveItem(tmpid,1,backpack,0,0,0);
// Grab(tmpid,GetQuantity(tmpid));
wait(1000);
checksave;
until tmpflag;
UseObject(tmpid);
wait(1000);
checksave;
Result := tmpid;
addtosystemjournal('Найден мешок с бумагой, взят в пак ' + inttostr(tmpid));
exit;
end;
Ignore(tmpid);
until tmpid = 0;
IgnoreReset;
end;
procedure DropEmptyBag(tmpid : Cardinal);
begin
waitconnection(3000);
OpenContainer(false);
MoveItem(tmpid,GetQuantity(tmpid),SundukEmptyBag,0,0,0);
wait(1000);
checksave;
AddtosystemJournal('Сбросил пустой мешок');
end;
function GrabResources : Boolean;
var tmpid : Cardinal;
tmpnum : integer;
begin
Result := False;
waitconnection(3000);
tmpnum := 0;
if (Count(TypCloth) < MinCloth) then
begin
OpenContainer(false);
tmpid := Findtype(TypCloth,ground);
if tmpid = 0 then exit;
Grab(finditem,MaxCloth);
wait(1000);
checksave;
addtosystemjournal('Взял ' + inttostr(MaxCloth) + ' cloths. В мешке: ' + inttostr(CountEx(TypPaper,$FFFF,curbag)) + ' листов бумаги');
end;
Result := True;
end;
procedure DropScroll;
var tmp1 : cardinal;
tmp2, tmp3 : Integer;
begin
waitconnection(3000);
if Count(TypScroll) < HowDropScroll then exit;
tmp3 := 0;
tmp1 := findtype(TypScroll,backpack);
while findcount > 0 do
begin
tmp2 := GetQuantity(tmp1);
Drop(tmp1,tmp2,0,0,0);
wait(500);
checksave;
tmp1 := findtype(TypScroll,backpack);
end;
addtosystemjournal('Сбросил ' + inttostr(tmp2) + ' blank scrolls');
end;
function CheckParthcment : Boolean;
var tmp1 : Cardinal;
tmptime : TDateTime;
begin
Result := false;
tmp1 := FindType(TypPaper,backpack);
while tmp1 <> 0 do
begin
tmptime := Now;
ClickOnObject(tmp1);
wait(1000);
checksave;
if InJournalBetweenTimes('Parchment', tmptime, Now)<>-1 then
begin
addtosystemjournal('test1: yes');
Result := true;
IgnoreReset;
exit;
end;
Ignore(tmp1);
tmp1 := FindType(TypPaper,backpack);
end;
IgnoreReset;
end;
Begin
IgnoreReset;
curbag := 0;
OldSkill := GetSkillValue('Carpentry');
LastContOpen := Now;
OpenContainer(true);
repeat
//1. Функция поиска в сундуке мешка с бумагой, взять его в пак, открыть
curbag := FindBagWithPapers;
if curbag = 0 then
begin
Addtosystemjournal('Бумага кончилась');
exit;
end;
FirstTime := True;
//2. Пока в этом мешке есть бумага делай:
While (CountEx(TypPaper,$FFFF,curbag) > 0) do
begin
//3. Проверить есть ли ткань, взять 50
if not GrabResources then
begin
Addtosystemjournal('Нету ткани на полу');
exit;
end;
//4. Крафт партчментов, проверка на 'You put' и таймер на 20 сек. Первый крафт через меню,
// последующие через .makelast
if FirstTime then
begin
waitconnection(3000);
OpenContainer(false);
CancelMenu;
if TargetPresent then CancelTarget;
ctime := Now;
WaitMenu('Carpentry', WhatYouDo);
if UseType(ToolsType,$FFFF) = 0 then exit;
k := 0;
repeat
wait(100);
k := k + 1;
checksave;
until (InJournalBetweenTimes('You put', ctime, Now)<>-1) or (k > 200);
if InJournalBetweenTimes('You put', ctime, Now)<>-1 then FirstTime := False;
end
else
begin
waitconnection(3000);
OpenContainer(false);
if TargetPresent then CancelTarget;
ctime := Now;
UOSay('.makelast');
k := 0;
repeat
wait(100);
k := k + 1;
checksave;
until (InJournalBetweenTimes('You put', ctime, Now)<>-1) or (k > 200);
if GetSkillValue('Carpentry') > OldSkill then
begin
AddToSystemJournal('Скилл Carpentry вырос. Теперь он равен ' + FloatToStr(GetSkillValue('Carpentry')));
OldSkill := GetSkillValue('Carpentry');
end;
end;
OpenContainer(false);
end;
//5. Когда бумага кончилась в мешке, делаем:
//6. Пока в паке есть партчменты, делай:
FirstTime := True;
//7. Крафтим бланкскроллы, первый крафт через меню, последующие через .makelast
While (Count(TypPaper) > 0) do
begin
if FirstTime then
begin
waitconnection(3000);
CancelMenu;
if TargetPresent then CancelTarget;
ctime := Now;
WaitMenu('Carpentry', WhatYouDo2);
if UseType(ToolsType,$FFFF) = 0 then exit;
k := 0;
repeat
wait(100);
k := k + 1;
checksave;
until (InJournalBetweenTimes('You put', ctime, Now)<>-1) or (k > 200);
if InJournalBetweenTimes('You put', ctime, Now)<>-1 then FirstTime := False;
end
else
begin
waitconnection(3000);
if TargetPresent then CancelTarget;
ctime := Now;
UOSay('.makelast');
k := 0;
repeat
wait(100);
k := k + 1;
checksave;
until (InJournalBetweenTimes('You put', ctime, Now)<>-1) or (k > 200);
if GetSkillValue('Carpentry') > OldSkill then
begin
AddToSystemJournal('Скилл Carpentry вырос. Теперь он равен ' + FloatToStr(GetSkillValue('Carpentry')));
OldSkill := GetSkillValue('Carpentry');
end;
end;
end;
//8. Когда партчментов нет, скидываем бланки на пол и пустой мешок в первый сундук
DropScroll;
DropEmptyBag(curbag);
until GetSkillValue('Carpentry') >= 100.0;
End.