Code: Select all
Program BowCraft_arrows;
var i : Integer;
Const
DaggerType = $0F51;
ShaftsType = $1BD4;
ArrowsType = $0F3F;
FeathersType = $1BD1;
{$Include 'all.inc'}
procedure FullDisconnect;
begin
SetARStatus(false);
Disconnect;
end;
procedure CheckShafts;
var k : Integer;
begin
WaitConnection(3000);
CheckSave;
findtype(ShaftsType, ground);
if (findquantity >= 100) then Exit;
Disconnect;
wait(5000);
WaitConnection(3000);
AddToSystemJournal('Мало Shafts! Ждем, пока ктото подкинет');
while findquantity < 100 do
begin
WaitConnection(3000);
CheckSave;
UOSay('У меня мало Shafts! Подкиньте кто-то Shafts!');
k := 0;
while (k < 20) and (findquantity < 100) do
begin
wait(10000);
k := k + 1;
findtype(ShaftsType, ground);
end;
hungry(1, ground);
wait(1000);
findtype(ShaftsType, ground);
end;
AddToSystemJournal('Shafts появились! Продолжаем работать дальше!');
end;
procedure CheckFeathers;
var k : Integer;
begin
WaitConnection(3000);
CheckSave;
findtype(FeathersType, ground);
if (findquantity >= 100) then Exit;
Disconnect;
wait(5000);
WaitConnection(3000);
AddToSystemJournal('Мало Feathers! Ждем, пока ктото подкинет');
while findquantity < 100 do
begin
WaitConnection(3000);
CheckSave;
UOSay('У меня мало Feathers! Подкиньте кто-то Feathers!');
k := 0;
while (k < 20) and (findquantity < 100) do
begin
wait(10000);
k := k + 1;
findtype(FeathersType, ground);
end;
hungry(1, ground);
wait(1000);
findtype(FeathersType, ground);
end;
AddToSystemJournal('Feathers появились! Продолжаем работать дальше!');
end;
procedure CheckDead;
begin
WaitConnection(3000);
CheckSave;
if Dead then
begin
SetWarMode(true);
WaitGump('1');
wait(5000);
while (Dead) do Wait (1000);
wait (2000);
Hungry(1, ground);
end;
end;
procedure CheckDaggers;
var c : Integer;
Begin
WaitConnection(3000);
CheckSave;
c := Count(DaggerType);
if c > 0 then Exit
else AddToSystemJournal('No daggers!');
End;
function GrabFeather : Boolean;
var c : Integer;
stime : TDateTime;
Feather : Cardinal;
begin
Feather := FindType(FeathersType,ground);
if Feather = 0 then
begin
AddToSystemJournal('Error with grab feather. Feather not finded at ground');
result := false;
Exit;
end;
stime := Now;
Grab(Feather, 1);
repeat
c := InJournalBetweenTimes('performing|doing', stime, Now);
wait(100);
until (Now > stime + (1.0/1440)) or (c >= 0) or (FindType(FeathersType,backpack) <> 0);
wait(100);
result := true;
end;
procedure Make;
var c : Integer;
stime : TDateTime;
Shafts : Cardinal;
Feather : Cardinal;
begin
if GrabFeather = false then
begin
wait(1000);
Exit;
end;
Shafts := FindType(ShaftsType,ground);
if Shafts = 0 then
begin
AddToSystemJournal('Error with make arrows. Shafts not finded at ground');
Exit;
end;
Feather := FindType(FeathersType,backpack);
if Feather = 0 then
begin
AddToSystemJournal('Error with make arrows. Feather not finded at backpack');
Exit;
end;
stime := Now;
UseObject(Feather);
WaitTargetObject(Shafts);
wait(200);
repeat
c := InJournalBetweenTimes('performing|doing', stime, Now);
InJournalBetweenTimes('create|make|destroy', stime, Now);
wait(100);
until (LineCount >= 1) or (Now > stime + (1.0/1440)) or (c >= 0);
wait(100);
end;
Begin
AutoMenu('create','Arrow');
FindDistance := 2;
WaitConnection(3000);
CheckSave;
wait(5000);
SetARStatus(true);
findtype(ArrowsType, backpack);
if FindFullQuantity > 1 then
begin
AddToSystemJournal('Stack');
Stack(ArrowsType, GetColor(finditem));
wait(1000);
end;
while true do
begin
findtype(ArrowsType, backpack);
if FindFullQuantity > 100 then
begin
AddToSystemJournal('Stack');
Stack(ArrowsType, GetColor(finditem));
wait(1000);
end;
FindType(FeathersType,ground);
AddToSystemJournal('Осталось '+IntToStr(FindFullQuantity)+' перьев.');
WaitConnection(3000);
CheckSave;
CheckTargetError(5, 2);
CheckDead;
CheckDaggers;
CheckShafts;
CheckFeathers;
Hungry(1, ground);
wait(1000);
i := 0;
while i < 200 do
begin
Make;
i := i + 1;
end;
end;
End.