Простенький Animal Taming

Edred · Post by **Edred** » 18.09.2006 9:06

program tamingUp;
// (c) Edred

var 
animal : cardinal;
k : integer;
ctime : TDateTime;

{$Include 'all.inc'}

Begin

	animal := $00053BDB;

	While not Dead do
	begin
		while not connected do wait(100);
		if TargetPresent then CancelTarget;
		ctime := Now;
		UseSkill('Animal Taming');
		WaitTargetObject( animal );
		k := 0
		repeat
			wait(100);
			k := k + 1;
		until (InJournalBetweenTimes('accept you as master|You fail|is already tame.', ctime, Now)<>-1) or (k > 600);
		If (injournal('accept you as master|is already tame.')<>-1) or (k>600) then uosay('all release' );
		wait(1000);
		CheckSave;
	end;

End.

ps: чуть усовершенствовал.

Dr.Assassin · Post by **Dr.Assassin** » 13.11.2006 20:40

Вот скрипт для шарда Fields of Fire,
там такая особенность - что нельзя тамить одно животное
два раза подряд, одним и тем же чаром.

Поэтому тамим одновременно обома чарами - по очереди
всех тварей из таблицы ANIMAL:
Статистику об успехах и неудачах сохраняем
в таблицах TAME_OK, TAME_FAIL,
и раз в пару минут выводим её в SystemJournal'e.

Code: Select all

Program Taming; 
var i: Integer; 
    xxx: Integer; 
    ANIMAL,TAME_OK,TAME_FAIL : Array[1..8] of cardinal; 
    A_COUNT:integer;//количество животных :-D
    timez,t_use: TDateTime; 
    s:string;
{$Include 'all.inc'} 
Begin 
{==================================} 
ANIMAL[1]:=$00d0b2c2;//brown bear
ANIMAL[2]:=$00d0a909;//brown bear
ANIMAL[3]:=$00d0b2aa;//pack lama
ANIMAL[4]:=$00d0b29c;//pack lama
A_COUNT:=4;
{==================================} 
 xxx:=1;
 ClearJournal; 
 timez:=now;
 t_use:=now;
 SetARStatus(true); 
 FindDistance:=2; 
 Hungry(1,ground);  
while true do begin 
 While not Dead do begin 
  If Connected then begin 
    For i:= 1 to 300 do begin {период за который мы должны проголодаться}
     
     if t_use+StrToTime('00:00:30')<now then 
           begin UseSkill('Animal Taming');
                  wait(1000);waitfortarget(3000);
                  if TargetPresent then TargetToObject(ANIMAL[xxx]);
                  t_use:=now; 
           end;
     if (InJournalBetweenTimes('You failed to tame the creature',timez,now)>=0)
     or (InJournalBetweenTimes('You seem to have upset the beast',timez,now)>=0)
     then begin //UOSay('release all');
                 TAME_FAIL[xxx]:=TAME_FAIL[xxx]+1;
                 if xxx<A_COUNT then xxx:=xxx+1 else xxx:=1;
                 timez:=now;
           end;    
     if (InJournalBetweenTimes('You successfully tame',timez,now)>=0)
     then begin UOSay('all release');
                 TAME_OK[xxx]:=TAME_OK[xxx]+1;
                 if xxx<A_COUNT then xxx:=xxx+1 else xxx:=1;
                 timez:=now;
           end;    
     if (InJournalBetweenTimes('already',timez,now)>=0)
     then begin UOSay('all release');
                 if xxx<A_COUNT then xxx:=xxx+1 else xxx:=1;
                 timez:=now;
           end;    
      wait(1000);           
    end;//for
    Hungry(1,ground);  
    s:='  OK [';
    for i:=1 to A_COUNT do begin
      s:=s+' '+intToStr(TAME_OK[i])+' ,';  
    end;
    s:=s+']';
    AddToSystemJournal(s);
    s:='FAIL [';             
    for i:=1 to A_COUNT do begin
      s:=s+' '+intToStr(TAME_FAIL[i])+' ,';  
    end;
    s:=s+']';
    AddToSystemJournal(s);
  end else waitconnection(3000);{ждём кода бум в онлайне}
 end;//dead
 wait(30000); 
 SetWarMode(True); 
end;//while true  
End.

*13* · Post by ***13*** » 21.11.2006 19:23

1) ты не учёл еще одну особеность нашего шарда- на этаже не больше 3 животных

2) не release all а all release

Edred · Post by **Edred** » 21.11.2006 20:51

Обычно на шардах по фиг: all release или release all. От перемены мест сумма не меняется.

Macks · Post by **Macks** » 25.11.2006 12:18

А то что животное убегает, телепортится на тебя, вступает в бой, бъет магией, хилять его и себя нужно и в доме не тамиться, возможно учесть?

Edred · Post by **Edred** » 25.11.2006 12:49

Возможно все. Флаг в руки.

id · Post by id » 22.01.2007 10:56

Отличный скрипт. Но иногда слетает, не могу понять кто виноват - скрипт, сервер, мб - я?:)
Слетает довольно интересно. Просто перестаёт ждать и пишет:
Tame which animal?
Taming...
Tame which animal?
Taming...
Tame which animal?
Taming...

Без всяких задержек. Помогает рестарт скрипта. Иногда реконнект. Иногда только оба сразу.
Не могу понять в чем дело.

Edred · Post by **Edred** » 24.01.2007 0:47

Ты про какой скрипт? Их тут два уже в этом топике.

id · Post by id » 24.01.2007 11:18

Про первый - твой.

Lokkie · Post by **Lokkie** » 24.01.2007 12:19

Подозреваю, что у id шард под RunUO и поэтому ловля фраз в until не работает - он выходит по таймауту. клилоки проставь

id · Post by id » 24.01.2007 17:22

Не-а. Шард ДРВ. Там самый обычный таминг.

Edred · Post by **Edred** » 24.01.2007 17:53

В первую голову - сообщения другие или их больше. Я вообще-то на этом скрипте не качаю давно, это так, для разминки было написано. Последнее, на чем качал, было вот это:

Code: Select all

program tamingUp;
// v.1.02 (c) Edred

{$Include 'all.inc'}

var 
animal : cardinal;
k : integer;
nom : integer;
ctime : TDateTime;
NameHorse : String;
Horse : array [1..10] of Cardinal;
OldSkill : Double;

Begin
	Horse[1] := $00E1;			// Wolf. Skill = 17.5
	Horse[2] := $00CC;			// Horse. Skill = 28.0
	Horse[3] := $0123;			// Pack Horse. Skill = 52.5
	Horse[4] := $00DC;			// Llama. Skill = 73.0
	Horse[5] := $0124;			// Pack Llama. Skill = 75.0
	Horse[6] := $00DB;			// Orn. Skill = 77.0
	Horse[7] := $00D5;			// Bear. Skill = 85.0
//	Horse[8] := $00DA;			// Zostr. Skill = 89.0
	Horse[8] := $00DA;			// Gold. Skill = 92.0

	Finddistance := 1;
	OldSkill := GetSkillValue('Animal Taming');
	While (not Dead) AND (GetSkillValue('Animal Taming') < 100.0) do
	begin
		if GetSkillValue('Animal Taming') > 17.5 then nom := 1;
		if GetSkillValue('Animal Taming') > 28.0 then nom := 2;
		if GetSkillValue('Animal Taming') > 52.5 then nom := 3;
		if GetSkillValue('Animal Taming') > 73.0 then nom := 4;
		if GetSkillValue('Animal Taming') > 75.0 then nom := 5;
		if GetSkillValue('Animal Taming') > 77.0 then nom := 6;
		if GetSkillValue('Animal Taming') > 85.0 then nom := 7;
		if GetSkillValue('Animal Taming') > 89.0 then nom := 8;
		while not connected do wait(100);
		repeat
			findtype( Horse[nom], ground);
			animal := finditem;
			if animal = 0 then nom := nom - 1;
			if nom = 0 then exit;
		until animal <> 0;
		NameHorse := GetName(finditem);
//		AddToSystemJournal('Нашел ' + NameHorse);
		waitconnection(3000);
		if TargetPresent then CancelTarget;
		ctime := Now;
		UseSkill('Animal Taming');
		WaitTargetObject( animal );
		k := 0
		repeat
			wait(100);
			k := k + 1;
		until (InJournalBetweenTimes('accept you as master|You fail|is already tame.', ctime, Now)<>-1) or (k > 600);
		If (injournal('accept you as master|is already tame.')<>-1) or (k>600) then uosay(NameHorse + ' release' );
		wait(1000);
		waitconnection(3000);
		CheckSave;
		if GetSkillValue('Animal Taming') > OldSkill then
		begin
			AddToSystemJournal('Скилл Animal Taming вырос. Теперь он равен ' + FloatToStr(GetSkillValue('Animal Taming')));
			OldSkill := GetSkillValue('Animal Taming');
		end;
		waitconnection(3000);
	end;
End.

id · Post by id » 24.01.2007 18:01

Ну сама прокачка точно такая же. Основа не поменялась.

id · Post by id » 24.01.2007 23:25

И ещё очень плохо - сбивается скрипт полностью после реконнекта, просто перестаёт работать.