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

Carpentry (Blank Scrolls) для шарда Forest Wars

Only working scripts
Post Reply
Edred
Moderator
Moderator
Posts: 559
Joined: 28.03.2006 21:29

Carpentry (Blank Scrolls) для шарда Forest Wars

Post by Edred »

На шарде очень сложная процедура крафта blank scrolls:
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.
2 ЭТАП. Делаем бумагу, раскладываем по мешкам.

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.
3 и 4 ЭТАП. Крафтим партчменты и бланкскроллы. Берем из мешков, пустые мешки обратно в первый сундук

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.
Illusionss
Posts: 3
Joined: 29.06.2012 17:35

Re: Carpentry (Blank Scrolls) для шарда Forest Wars

Post by Illusionss »

Дико извиняюсь за такое некропостерство, но есть проблема, помочь не могут.
Шаги 1 и 3,4 работают в идеале, все прекрасно, можно смело оставлять чара на неопределенное время, все будет делать.
В шаге 2 - переработка досок на бумагу, возникла проблема:

После ворлд-сейва, при условии, что в момент сейва персонаж не перетаскивал бумагу, а делал ее в журнале идет постоянное

Code: Select all

[17:46:58:765] System: You fail to complete the item.
[17:46:59:828] System: You fail to complete the item.
[17:47:00:937] System: You fail to complete the item.
[17:47:02:031] System: You fail to complete the item.
[17:47:03:156] System: You fail to complete the item.
[17:47:04:234] System: You fail to complete the item.
[17:47:05:375] System: You fail to complete the item.
[17:47:06:437] System: You fail to complete the item.
[17:47:07:625] System: You fail to complete the item.
[17:47:08:656] System: You fail to complete the item.
И так до бесконечности.
Другие три скрипта нормально реагируют на ворлд сейв, отличий не нашел, не в состоянии исправить.
Может кто подскажет где и как во втором скрипте исправить эту ошибку (проставить паузу, сделать перепроверку на сейв и т д)
Буду очень благодарен за помощь.
nepopus
Novice
Novice
Posts: 121
Joined: 29.02.2012 23:45
Location: Москва
Contact:

Re: Carpentry (Blank Scrolls) для шарда Forest Wars

Post by nepopus »

попробуй вставь во втором скрипте в отрезок с основным циклом

Code: Select all

      wait(200);
      if injournalbetweentimes('fail', ctime, now) > 0 then
        ctime := now;
чтобы получилось так:

Code: Select all

   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');

      wait(200);
      if injournalbetweentimes('fail', ctime, now) > 0 then
        ctime := now;

      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;
При начале крафта нового предмета, не закончив старый, происходит фейл старого, но в скрипте распознается как фейл текущего. Таким образом зацикливаются фейлы. Мое решение, поидее, должно убирать такой фейл на 2-3 заходе. Пиши, если не поможет или появятся другие глюки))
<( o_O<) <( O_O )> (>O_o )>
Illusionss
Posts: 3
Joined: 29.06.2012 17:35

Re: Carpentry (Blank Scrolls) для шарда Forest Wars

Post by Illusionss »

nepopus, Спасибо!
Ситуацию спасла команда чеклагс (15000) растыканная через каждую строчку в месте где идет крафт предмета.
Скрипт продержался без сбоев 4500 бумаги, но потом в итоге все-равно сбился)
Сейчас крафчу партачменты, потом бланки, потом доски и опять вернусь на исходную к бумаге. Попробую поколдовать с Вашим вариантом, может спасет вообще от этих треклятых циклов )
Post Reply