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

Bowcraft

Only working scripts
Post Reply
Miralex
Developer
Developer
Posts: 656
Joined: 11.03.2005 19:12
Contact:

Bowcraft

Post by Miralex »

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.
Шафты и перья должны быть на полу. Скрипт берет 1 перо с пола и делает стрелу.
Post Reply