https://ultima.od.ua/board/

Подскажите ламбер плз

https://ultima.od.ua/board/viewtopic.php?f=3&t=971

Страница 1 из 3

Подскажите ламбер плз

Добавлено: 12 сен 2024, 13:49
Carlpots
]Compiler: [Error] (C:\Users\user\Desktop\скрипты\Крафт\ламбер.txt at 155:1): Unknown identifier 'FullDisconnect'



Код: Выделить всё

Program AutoLumber;
 
{$Include 'all.inc'}

const
Xmin = 1552; //tyt zadaem quadrat uchastka, rde craft rubit logi
Xmax = 1578;
Ymin = 1646;
Ymax = 1639;

Trap = $4340422D ; // ID trap lodki

vozleX = 1532; // NEAR BOARD
vozleY = 1657;

lodkaX = 1526; // ONBOARD
lodkaY = 1658;

resX = 1472; // koord resalki 
resY = 1611; 

rb = $0EFA; 

kompas = 2;  // ??????????? ?????? ? ????? ?? ????? - 0 ??? 2 ??? 4 ??? 6
//6////0
////X - eto craft na lodke 'X', numbers - eto napravlenie 6 ili 0 ili 4 ili 2
//4////2

CopperType   = $1BF2;
IngotColor  = $07DF;
MyMaxWeight = 175; // MAX WES - kak naberet - idet na lodku
AxeType = $0F43;
AxeGump = '3907';
eda = $097B;
maxfood = 10;
iTTileCount = 183;
Msg1 = 'not enough';
Msg2 = 'broke';
Msg3 = 'far away|mine here|how to use those';
Msg4 = 'no more';
LogType = $1BDD;
DeadWoods = $0F90;
Tinktype = $1EB9;
TinkGump = '7865';

type
ChopTile = Record
x, y : Integer;
end;

var
FoundTilesArray : TFoundTilesArray;
TempFoundTilesArray, ChopTilesArray : array of TFoundTile;
TreeTile:array [0..iTTileCount] of word;
ctime : TDateTime;
i : Integer;
ETimer : Cardinal;

Procedure Eat;
Begin
If (GetTickCount > ETimer + (5 * 60 * 1000)) Then Begin
Hungry(1, -1);
ETimer := GetTickCount;
End;
End;

procedure checkcoord;
 begin
 CheckLag (30000);
 if (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) = 0 then
   begin
     repeat
     UseObject(Trap);
     CheckLag (30000);
     wait(1000);
     Raw_Move(kompas, True);
     CheckLag (30000);
     wait(500);
     Raw_Move(kompas, True);
     CheckLag (30000);
     wait(500);
     until (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) > 0;
   end;
 end;

procedure checkfish;
var food: integer;
 Begin
 if (count(eda) < maxfood) then
   begin
     repeat
     food:=count (eda);
     CheckLag (30000);
     FindType(eda,ground);
     if FindQuantity = 0 then continue;
     if (FindQuantity > (maxfood-food)) then
       begin
        grab (finditem, maxfood-food);
       end
     else grab (finditem, 0);
     CheckLag (30000);
     wait (1000);
     AddToSystemJournal('Food left: '+inttostr(count ($097B)-food));
     until (countground($097B)=0) or (count($097B)>(maxfood-1));
   end;
 end;

procedure CheckAxe;
var food: integer;
Begin
if (count($097B)<maxfood) then
repeat
food:=count ($097B);
WaitConnection(3000);
CheckSave;
FindType($097B,ground);
if finditem=0 then continue;
if (findquantity>(maxfood-food)) then grab (finditem, maxfood-food) else grab (finditem, 0);
wait (500);
//AddToSystemJournal('Food left '+inttostr(count ($097B))+' food');
until (countground($097B)=0) or (count($097B)>maxfood-1);
if (Count(AxeType) < 2) then
begin
begin
FindType(Tinktype,ground);
if FindCount < 2 then
begin
UseObject(FindType(Tinktype,ground));
WaitTargetobject(findtypeEX(CopperType,IngotColor,ground,false));
WaitGump(TinkGump)
wait(100);
WaitJournalLine(Now, 'You create|make|destroy|You put', 12000);
Drophere(FindType(TinkType,backpack));
wait(200);
end
else
begin
repeat
WaitConnection(3000);
CheckSave;
checkdead;
findtypeEX(CopperType,IngotColor,ground, false);
if FindCount > 0 then
begin
UseObject(FindType(TinkType,ground));
WaitTargetobject(findtypeEX(CopperType,IngotColor,ground, false));
WaitGump(AxeGump);
wait(150);
WaitJournalLine(Now, 'You create|make|destroy|You put', 12000);

end
else
begin
AddToSystemJournal('nema coopera!');
FullDisconnect;
end;
until Count(AxeType) >= 2
end

end
end
End;

procedure InitTTilesArray;
  begin
TreeTile[0] := 3299 
TreeTile[1] := 3293
TreeTile[2] := 3278
TreeTile[3] := 3294
TreeTile[4] := 3286
TreeTile[5] := 3278 
TreeTile[6] := 3293
TreeTile[7] := 3283
TreeTile[8] := 3277
TreeTile[9] := 3289
TreeTile[10] := 3303 
TreeTile[11] := 3297 
TreeTile[12] := 3300 
TreeTile[13] := 3291
TreeTile[14] := 3305


T
  end;

procedure InitSystem;
  begin
    SetArrayLength(ChopTilesArray, 1);
  end;

// ????? ????????
procedure SearchTree;
  var
  i, j : Integer;
  iFoundTilesArrayCount : word;
  iTempFoundTilesArrayCount : Integer;

  begin
    for i:= 0 to iTTileCount do
      begin
        iFoundTilesArrayCount := GetStaticTilesArray(Xmin, Ymin, Xmax, Ymax, 0, TreeTile[i], FoundTilesArray);
        if iFoundTilesArrayCount > 0 then
          begin
            SetArrayLength(TempFoundTilesArray, Length(TempFoundTilesArray) + iFoundTilesArrayCount);
            for j := 0 to iFoundTilesArrayCount - 1 do
              begin
                TempFoundTilesArray[iTempFoundTilesArrayCount + j] := FoundTilesArray[j];
              end;
            iTempFoundTilesArrayCount := iTempFoundTilesArrayCount + iFoundTilesArrayCount;
          end;
      end;
    AddToSystemJournal('iTempFoundTilesArrayCount: ' + IntToStr(iTempFoundTilesArrayCount));
  end;

// ?????? ?????? ????????? (Vizit0r :P)
procedure ClearDuplicate;
  var
  i, j : Integer;

  begin
    ChopTilesArray[Length(ChopTilesArray) - 1] := TempFoundTilesArray[0];
    for i:=1 to Length(TempFoundTilesArray) - 1 do
      begin
        for j:=0 to Length(ChopTilesArray) - 1 do
          if (ChopTilesArray[j] = TempFoundTilesArray[i]) then
            break;
        if j > Length(ChopTilesArray) - 1 then
          begin
            SetArrayLength(ChopTilesArray, Length(ChopTilesArray) + 1);
            ChopTilesArray[Length(ChopTilesArray) - 1] := TempFoundTilesArray[i];
          end;
      end;
      AddToSystemJournal('ClearDuplicate:' + IntToStr(Length(ChopTilesArray)));
  end;

// ???????? ? ??????? 2 (Shinma)
function sqr(a:LongInt):LongInt;
  begin
    result:=a*a;
  end;

// ????????? ????? ??????? (Shinma)
function vector_length(c_2:TFoundTile):LongInt;
  begin
    result:=Round(sqrt(sqr(GetX(self)-c_2.X)+sqr(GetY(self)-c_2.Y)));
  end;

procedure QuickSort(A: array of TFoundTile; l,r: integer);
  var
  i, j: Integer;
  x, y: TFoundTile;

  begin
    i := l;
    j := r;
    x := A[((l + r) div 2)];
    repeat
      while vector_length(A[i]) < vector_length(x) do inc(i);
      while vector_length(x) < vector_length(A[j]) do dec(j);
      if not (i>j) then
        begin
          y:= A[i];
          A[i]:= A[j];
          A[j]:= y;
          inc(i);
          dec(j);
        end;
    until i>j;
    if l < j then QuickSort(ChopTilesArray, l,j);
    if i < r then QuickSort(ChopTilesArray, i,r);
  end;

procedure MarkTrees;
  begin
    SearchTree;
    AddToSystemJournal('MarkTrees: ' + IntToStr(Length(TempFoundTilesArray)));
    ClearDuplicate;
    QuickSort(ChopTilesArray, 0, Length(ChopTilesArray) - 1);
  end;

// ?????????
procedure DropLog;
 var g : integer;
 LogCol : Array [0..20] of Word;
Begin
 finddistance := 2;
 CheckLag (30000);
 AddToSystemJournal('DropLog');
 LogCol[0] := $0000; // Log
 LogCol[1] := $0362; // Jade
 LogCol[2] := $010D; // Oak
 LogCol[3] := $0094; // Karund
 LogCol[4] := $01B0; // Leshram
 LogCol[5] := $01A2; // Tourmalite
 LogCol[6] := $0026; // Emerint
 LogCol[7] := $00CB; // Legrand
 LogCol[8] := $094A; // Solmur
 LogCol[9] := $092B; // Kleor
 LogCol[10] := $0931; // Logradoom
 LogCol[11] := $093F; // Vialonit
 LogCol[12] := $0074; // Stardust
 LogCol[13] := $006F; // Pyronil
 LogCol[14] := $09EF; // Mystic
 LogCol[15] := $0119; // Elvin
 LogCol[16] := $000B; // Elkris
 for g := 0 to 16 do
 begin
 CheckLag (30000);
 FindTypeEx(LogType,LogCol[g],backpack,false);
 if FindCount > 0 then
  begin
   stack(LogType,LogCol[g]);
   CheckLag (30000);
   wait(1000);
  end;
 end;
 FindTypeEx(DeadWoods,$ffff,backpack,false);
 if FindCount > 0 then
  begin
   stack(DeadWoods,$ffff);
   CheckLag (30000);
   wait(1000);
  end;
 hungry (1,-1);
 wait(500);
 Addtosystemjournal('=========================================');
 FindType(LogType,ground);
 Addtosystemjournal('total logs - '+intToStr(findfullquantity));
 FindTypeEx(LogType,$0000,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Log - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$0362,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Jade - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$010D,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Oak - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$0094,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Karund - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$01B0,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Leshram - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$01A2,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Tourmalite - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$0026,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Emerint - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$00CB,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Legrand - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$094A,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Solmur - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$092B,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Kleor - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$0931,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Logradoom - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$093F,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Vialonit - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$0074,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Stardust - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$006F,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Pyronil - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$09EF,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Mystic - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$0119,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Elvin - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$000B,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Elkris - '+intToStr(findfullquantity));
 end;
 
FindType(CopperType,ground);
Addtosystemjournal('Copper-ingots: ' + intToStr(findfullquantity));
FindType(eda,ground);
Addtosystemjournal('Fish-steaks: ' + intToStr(findfullquantity));
Addtosystemjournal('=========================================');
 
End;

procedure resself;
begin
AddToSystemJournal('Resself. Enter');
WaitConnection(3000);
checksave;
Wait(1000);
WaitGump('1');
setwarmode(true);
while dead do wait(1000);
if findtype($2006,ground) > 0 then begin
if targetpresent then canceltarget;
waittargetobject(finditem);
useobject(findtype($0F51,ground));wait(1000);
end;
hungry(1,ground);
Wait(30000);
UOSay('Thx');
AddToSystemJournal('Resself. Exit');
end;

// GotoOnBoad
procedure GotoOnBoad;
begin
if (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) > 0 then
  begin
   repeat
   CheckLag (30000);
   NewMoveXY(vozleX,vozleY, True, 0, True);
   CheckLag (30000);
   wait(1000);
   until (Dist(GetX(Self), GetY(Self), vozleX, vozleY)) = 0;
if (Dead) then
  begin
   repeat
   CheckLag (30000);
   NewMoveXY(resX,resY, True, 0, True);
   CheckLag (30000);
   wait(500);
   WaitGump('1');
   until (Dist(GetX(Self), GetY(Self), resX, resY)) = 0;
   while dead do resself;
   repeat
   CheckLag (30000);
   SetWarMode(false);
   NewMoveXY(vozleX,vozleY, True, 0, True);
   CheckLag (30000);
   wait(1000);
   until (Dist(GetX(Self), GetY(Self), vozleX, vozleY)) = 0;
  end;
   repeat
   UseObject(Trap);
   CheckLag (30000);
   wait(1000);
   UseObject(Trap);
   CheckLag (30000);
   NewMoveXY(lodkaX,lodkaY, True, 0, True);
   CheckLag (30000);
   wait(1000);
   until (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) = 0;
  end;
if (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) = 0 then
  begin
   CheckDead;
   Hungry(1,ground);
   DropLog;
   CheckAxe;
   checkfish;
   checkcoord;
  end;
end;

procedure CheckEquip;
 Var EquipAxe : Cardinal;
 begin
 if (GetType(ObjAtLayer(LhandLayer)) <> AxeType) then
  begin
   Disarm;
   CheckLag (30000);
   wait(500);
   FindType(AxeType, Backpack);
   if (FindCount > 0) then
    begin
     EquipAxe := finditem;
     Equip(LhandLayer, EquipAxe);
     CheckLag (30000);
     wait(500);
    end
    else GotoOnBoad;
   end;
 end;

procedure BrosaemMusor;
 var t : integer;
 Cvet : Array [0..7] of Word;
 Begin
  finddistance := 2;
  CheckLag (30000);
//  AddToSystemJournal('Sbrasivaem musor!');
  Cvet[0] := $0000; // Log
  Cvet[1] := $0362; // Jade
  Cvet[2] := $010D; // Oak
  Cvet[3] := $0094; // Karund
  Cvet[4] := $01B0; // Leshram
  Cvet[5] := $01A2; // Tourmalite 
  Cvet[6] := $0026; // Emerint
  Cvet[7] := $00CB; // Legrand
  for t := 0 to 7 do
   begin
   CheckLag (30000);
   FindTypeEx(LogType,Cvet[t],backpack,false);
   if FindCount > 0 then
     begin
     CheckLag(30000);
     MoveItem(finditem, 0, ground, 0, 0, 0);
     wait(300);
     end;
   end;
  CheckEquip;
 end;

function LumbCurTree(tile,x,y,z : Integer) : Boolean;
  var
  q, m1, m2, m3, m4, NextTree : integer;

  begin
   Result := true;
    repeat
     Eat;
           
     CheckLag (30000);
     If TargetPresent Then CancelTarget;
     if (GetType(ObjAtLayer(LhandLayer)) = AxeType) then
     CheckEquip;
     if WarMode = true then SetWarMode(false);
     if TargetPresent then CancelTarget;
     ctime := Now;
     CheckLag (30000);
     CheckEquip;
     wait(500);
     CheckLag (30000);
     WaitTargetTile(tile, x, y, z);
     UseObject(ObjAtLayer(LhandLayer));
     CheckLag (30000);
     q := 0;
      repeat
       wait(100);
       q := q + 1;
       checksave;
       m1 := InJournalBetweenTimes(Msg1, ctime, Now);
       m2 := InJournalBetweenTimes(Msg2, ctime, Now);
       m3 := InJournalBetweenTimes(Msg3, ctime, Now);
       m4 := InJournalBetweenTimes(Msg4, ctime, Now);
      until (m1<>-1) or (m2<>-1) or (m3<>-1) or (m4<>-1) or Dead or (q > 450);
       BrosaemMusor;
      if Dead or (Weight > MyMaxWeight) then
      begin
       Result := false;
       exit;
      end;
     if (q > 200) then NextTree := NextTree + 1;
    until (m1<>-1) OR (m2<>-1) OR (m3<>-1) OR (m4<>-1)OR (NextTree > 3);
   if NextTree >= 3 then NextTree := 0;
  end;

// ??????? ???????
Begin
SetARStatus(True);
Addtosystemjournal('Begin.');
  BrosaemMusor;
  GotoOnBoad;
  InitTTilesArray;
  InitSystem;
  MarkTrees;

 while (not dead) and (connected) do
    begin
     for i:= 0 to Length(ChopTilesArray) - 1 do
      begin
        Disarm;
        NewMoveXY(ChopTilesArray[i].x, ChopTilesArray[i].y, true, 1, true);
        Addtosystemjournal('Tile Number: '+intToStr(i+1)+'.');
        if not LumbCurTree(ChopTilesArray[i].tile, ChopTilesArray[i].x, ChopTilesArray[i].y, ChopTilesArray[i].z) then GotoOnBoad;
      end;
    end;
End.

[/code

Re: Подскажите ламбер плз

Добавлено: 12 сен 2024, 17:09
Turner
используй теги код для читаемости
у тебя не хватает инклюда фул дисконект
или добавь или поудаляй его вызов

Re: Подскажите ламбер плз

Добавлено: 12 сен 2024, 22:29
Carlpots
Turner писал(а): ↑12 сен 2024, 17:09 используй теги код для читаемости
у тебя не хватает инклюда фул дисконект
или добавь или поудаляй его вызов
чтобы синим было выделенно всмысл. - скрипт


01:29:01:740 [Chibo Xiao]: Compiling
01:29:01:913 [Chibo Xiao]: Compiler: [Error] (C:\Users\user\Desktop\скрипты\Крафт\ламбер.txt at 154:1): Semicolon (';') expected
01:29:01:913 [Chibo Xiao]: Compilation failed
01:29:01:913 [Chibo Xiao]: Script ламбер.txt stopped successfuly

теперь такое пишет

Re: Подскажите ламбер плз

Добавлено: 13 сен 2024, 05:35
Turner
semicolon.jpg
semicolon.jpg (112.48 КБ) 3757 просмотров

Re: Подскажите ламбер плз

Добавлено: 13 сен 2024, 11:11
Carlpots
Turner писал(а): ↑13 сен 2024, 05:35semicolon.jpg
и где их ставить? строка 154 если то указано всенормально....

п.с. спасибо за подсказки

Re: Подскажите ламбер плз

Добавлено: 14 сен 2024, 08:44
Turner
строка 154 символ номер один - значит надо посмотреть конец 153 строки

Re: Подскажите ламбер плз

Добавлено: 14 сен 2024, 12:22
Carlpots
Turner писал(а): ↑14 сен 2024, 08:44 строка 154 символ номер один - значит надо посмотреть конец 153 строки
15:21:30:977 [Chibo Xiao]: Compiler: [Error] (C:\Users\user\Desktop\скрипты\Крафт\ламбер.txt at 154:1): Identifier expected

Re: Подскажите ламбер плз

Добавлено: 18 сен 2024, 19:32
Nightwolf
слушай не охота рыться шо ты там наклацал, давай вот рабочий скрипт возьмешь свои координаты / ид трапа поменяешь?

Код: Выделить всё

 Program AutoLumber;
 
{$Include 'all.inc'}

const
Xmin = 000; // max min koordinaty w lesu de budesh rubit
Xmax = 000;
Ymin = 000;
Ymax = 0000;

Trap = $005D2830; // ID ????? ?? ?????

vozleX = 000; // NEAR BOARD
vozleY = 0000;

lodkaX = 000; // ONBOARD
lodkaY = 0000;

resX = 000; //koordinaty resalki - esli est takaja
resY = 0000; 

rb = $0EFA; 

kompas = 2;  // naprawlenie wyhoda s lodki
//6////0
////X - ??? ????? ???
//4////2

CopperType   = $1BF2;  // Konstanta
IngotColor  = $006F;  //cvet ingot s kotoryx craft delaet topory dlja lumbera
MyMaxWeight = 175; // max wes pri kotorom idet na lodku skidyvat derewo
AxeType = $0F43;
AxeGump = '3907';
eda = $097B;
maxfood = 10;
iTTileCount = 183;
Msg1 = 'not enough';
Msg2 = 'broke';
Msg3 = 'far away|mine here|how to use those';
Msg4 = 'no more';
LogType = $1BDD;
DeadWoods = $0F90;
Tinktype = $1EB9;
TinkGump = '7865';

type
ChopTile = Record
x, y : Integer;
end;

var
FoundTilesArray : TFoundTilesArray;
TempFoundTilesArray, ChopTilesArray : array of TFoundTile;
TreeTile:array [0..iTTileCount] of word;
ctime : TDateTime;
i : Integer;
ETimer : Cardinal;

Procedure Eat;
Begin
If (GetTickCount > ETimer + (5 * 60 * 1000)) Then Begin
Hungry(1, -1);
ETimer := GetTickCount;
End;
End;

procedure checkcoord;
 begin
 CheckLag (30000);
 if (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) = 0 then
   begin
     repeat
     UseObject(Trap);
     CheckLag (30000);
     wait(1000);
     Raw_Move(kompas, True);
     CheckLag (30000);
     wait(500);
     Raw_Move(kompas, True);
     CheckLag (30000);
     wait(500);
     until (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) > 0;
   end;
 end;

procedure checkfish;
var food: integer;
 Begin
 if (count(eda) < maxfood) then
   begin
     repeat
     food:=count (eda);
     CheckLag (30000);
     FindType(eda,ground);
     if FindQuantity = 0 then continue;
     if (FindQuantity > (maxfood-food)) then
       begin
        grab (finditem, maxfood-food);
       end
     else grab (finditem, 0);
     CheckLag (30000);
     wait (1000);
     AddToSystemJournal('Food left: '+inttostr(count ($097B)-food));
     until (countground($097B)=0) or (count($097B)>(maxfood-1));
   end;
 end;

procedure CheckAxe;
var food: integer;
Begin
if (count($097B)<maxfood) then
repeat
food:=count ($097B);
WaitConnection(3000);
CheckSave;
FindType($097B,ground);
if finditem=0 then continue;
if (findquantity>(maxfood-food)) then grab (finditem, maxfood-food) else grab (finditem, 0);
wait (500);
//AddToSystemJournal('Food left '+inttostr(count ($097B))+' food');
until (countground($097B)=0) or (count($097B)>maxfood-1);
if (Count(AxeType) < 2) then
begin
begin
FindType(Tinktype,ground);
if FindCount < 2 then
begin
UseObject(FindType(Tinktype,ground));
WaitTargetobject(findtypeEX(CopperType,IngotColor,ground,false));
WaitGump(TinkGump);
wait(100);
WaitJournalLine(Now, 'You create|make|destroy|You put', 12000);
Drophere(FindType(TinkType,backpack));
wait(200);
end
else
begin
repeat
WaitConnection(3000);
CheckSave;
checkdead;
findtypeEX(CopperType,IngotColor,ground, false);
if FindCount > 0 then
begin
UseObject(FindType(TinkType,ground));
WaitTargetobject(findtypeEX(CopperType,IngotColor,ground, false));
WaitGump(AxeGump);
wait(150);
WaitJournalLine(Now, 'You create|make|destroy|You put', 12000);

end
else
begin
AddToSystemJournal('nema coopera!');
FullDisconnect;
end;
until Count(AxeType) >= 2
end

end
end
End;

procedure InitTTilesArray;
  begin
TreeTile[0] := 3230;
TreeTile[1] := 3231;
TreeTile[2] := 3232;
TreeTile[3] := 3233;
TreeTile[4] := 3234;
TreeTile[5] := 3235;
TreeTile[6] := 3236;
TreeTile[7] := 3237;
TreeTile[8] := 3238;
TreeTile[9] := 3239;
TreeTile[10] := 3240;
TreeTile[11] := 3241;
TreeTile[12] := 3242;
TreeTile[13] := 3243;
TreeTile[14] := 3244;
TreeTile[15] := 3245;
TreeTile[16] := 3246;
TreeTile[17] := 3247;
TreeTile[18] := 3248;
TreeTile[19] := 3249;
TreeTile[20] := 3250;
TreeTile[21] := 3251;
TreeTile[22] := 3252;
TreeTile[23] := 3253;
TreeTile[24] := 3254;
TreeTile[25] := 3255;
TreeTile[26] := 3256;
TreeTile[27] := 3257;
TreeTile[28] := 3258;
TreeTile[29] := 3259;
TreeTile[30] := 3260;
TreeTile[31] := 3261;
TreeTile[32] := 3262;
TreeTile[33] := 3263;
TreeTile[34] := 3264;
TreeTile[35] := 3265;
TreeTile[36] := 3266;
TreeTile[37] := 3267;
TreeTile[38] := 3268;
TreeTile[39] := 3269;
TreeTile[40] := 3270;
TreeTile[41] := 3271;
TreeTile[42] := 3272;
TreeTile[43] := 3273;
TreeTile[44] := 3274;
TreeTile[45] := 3275;
TreeTile[46] := 3276;
TreeTile[47] := 3277;
TreeTile[48] := 3278;
TreeTile[49] := 3279;
TreeTile[50] := 3280;
TreeTile[51] := 3281;
TreeTile[52] := 3282;
TreeTile[53] := 3283;
TreeTile[54] := 3284;
TreeTile[55] := 3285;
TreeTile[56] := 3286;
TreeTile[57] := 3299;
TreeTile[58] := 3305;
TreeTile[59] := 3306;
TreeTile[60] := 3307;
TreeTile[61] := 3308;
TreeTile[62] := 3309;
TreeTile[63] := 3315;
TreeTile[64] := 3316;
TreeTile[65] := 3317;
TreeTile[66] := 3318;
TreeTile[67] := 3319;
TreeTile[68] := 3320;
TreeTile[69] := 3321;
TreeTile[70] := 3322;
TreeTile[71] := 3323;
TreeTile[72] := 3324;
TreeTile[73] := 3325;
TreeTile[74] := 3326;
TreeTile[75] := 3327;
TreeTile[76] := 3328;
TreeTile[77] := 3329;
TreeTile[78] := 3330;
TreeTile[79] := 3331;
TreeTile[80] := 3332;
TreeTile[81] := 3333;
TreeTile[82] := 3334;
TreeTile[83] := 3335;
TreeTile[84] := 3336;
TreeTile[85] := 3337;
TreeTile[86] := 3338;
TreeTile[87] := 3339;
TreeTile[88] := 3340;
TreeTile[89] := 3393;
TreeTile[90] := 3394;
TreeTile[91] := 3395;
TreeTile[92] := 3396;
TreeTile[93] := 3397;
TreeTile[94] := 3398;
TreeTile[95] := 3403;
TreeTile[96] := 3405;
TreeTile[97] := 3409;
TreeTile[98] := 3410;
TreeTile[99] := 3411;
TreeTile[100] := 3412;
TreeTile[101] := 3413;
TreeTile[102] := 3414;
TreeTile[103] := 3415;
TreeTile[104] := 3416;
TreeTile[105] := 3417;
TreeTile[106] := 3418;
TreeTile[107] := 3419;
TreeTile[108] := 3420;
TreeTile[109] := 3421;
TreeTile[110] := 3422;
TreeTile[111] := 3423;
TreeTile[112] := 3426;
TreeTile[113] := 3427;
TreeTile[114] := 3428;
TreeTile[115] := 3429;
TreeTile[116] := 3430;
TreeTile[117] := 3431;
TreeTile[118] := 3432;
TreeTile[119] := 3433;
TreeTile[120] := 3434;
TreeTile[121] := 3435;
TreeTile[122] := 3436;
TreeTile[123] := 3437;
TreeTile[124] := 3438;
TreeTile[125] := 3439;
TreeTile[126] := 3440;
TreeTile[127] := 3441;
TreeTile[128] := 3442;
TreeTile[129] := 3443;
TreeTile[130] := 3444;
TreeTile[131] := 3445;
TreeTile[132] := 3446;
TreeTile[133] := 3447;
TreeTile[134] := 3449;
TreeTile[135] := 3450;
TreeTile[136] := 3451;
TreeTile[137] := 3452;
TreeTile[138] := 3453;
TreeTile[139] := 3454;
TreeTile[140] := 3455;
TreeTile[141] := 3456;
TreeTile[142] := 3457;
TreeTile[143] := 3458;
TreeTile[144] := 3459;
TreeTile[145] := 3460;
TreeTile[146] := 3461;
TreeTile[147] := 3462;
TreeTile[148] := 3463;
TreeTile[149] := 3464;
TreeTile[150] := 3465;
TreeTile[151] := 3467;
TreeTile[152] := 3468;
TreeTile[153] := 3469;
TreeTile[154] := 3470;
TreeTile[155] := 3471;
TreeTile[156] := 3472;
TreeTile[157] := 3473;
TreeTile[158] := 3474;
TreeTile[159] := 3475;
TreeTile[160] := 3476;
TreeTile[161] := 3477;
TreeTile[162] := 3478;
TreeTile[163] := 3479;
TreeTile[164] := 3480;
TreeTile[165] := 3481;
TreeTile[166] := 3482;
TreeTile[167] := 3483;
TreeTile[168] := 3484;
TreeTile[169] := 3485;
TreeTile[170] := 3486;
TreeTile[171] := 3487;
TreeTile[172] := 3488;
TreeTile[173] := 3489;
TreeTile[174] := 3490;
TreeTile[175] := 3491;
TreeTile[176] := 3492;
TreeTile[177] := 3493;
TreeTile[178] := 3494;
TreeTile[179] := 3495;
TreeTile[180] := 3496;
TreeTile[181] := 3497;
TreeTile[182] := 3498;
TreeTile[183] := 3499;
  end;

// ????????????? ????????? ??????????
procedure InitSystem;
  begin
    SetArrayLength(ChopTilesArray, 1);
  end;

// ????? ????????
procedure SearchTree;
  var
  i, j : Integer;
  iFoundTilesArrayCount : word;
  iTempFoundTilesArrayCount : Integer;

  begin
    for i:= 0 to iTTileCount do
      begin
        iFoundTilesArrayCount := GetStaticTilesArray(Xmin, Ymin, Xmax, Ymax, 0, TreeTile[i], FoundTilesArray);
        if iFoundTilesArrayCount > 0 then
          begin
            SetArrayLength(TempFoundTilesArray, Length(TempFoundTilesArray) + iFoundTilesArrayCount);
            for j := 0 to iFoundTilesArrayCount - 1 do
              begin
                TempFoundTilesArray[iTempFoundTilesArrayCount + j] := FoundTilesArray[j];
              end;
            iTempFoundTilesArrayCount := iTempFoundTilesArrayCount + iFoundTilesArrayCount;
          end;
      end;
    AddToSystemJournal('iTempFoundTilesArrayCount: ' + IntToStr(iTempFoundTilesArrayCount));
  end;

// ?????? ?????? ????????? (Vizit0r :P)
procedure ClearDuplicate;
  var
  i, j : Integer;

  begin
    ChopTilesArray[Length(ChopTilesArray) - 1] := TempFoundTilesArray[0];
    for i:=1 to Length(TempFoundTilesArray) - 1 do
      begin
        for j:=0 to Length(ChopTilesArray) - 1 do
          if (ChopTilesArray[j] = TempFoundTilesArray[i]) then
            break;
        if j > Length(ChopTilesArray) - 1 then
          begin
            SetArrayLength(ChopTilesArray, Length(ChopTilesArray) + 1);
            ChopTilesArray[Length(ChopTilesArray) - 1] := TempFoundTilesArray[i];
          end;
      end;
      AddToSystemJournal('ClearDuplicate:' + IntToStr(Length(ChopTilesArray)));
  end;

// ???????? ? ??????? 2 (Shinma)
function sqr(a:LongInt):LongInt;
  begin
    result:=a*a;
  end;

// ????????? ????? ??????? (Shinma)
function vector_length(c_2:TFoundTile):LongInt;
  begin
    result:=Round(sqrt(sqr(GetX(self)-c_2.X)+sqr(GetY(self)-c_2.Y)));
  end;

// «??????? ??????????» ?? ????? ???????, ?? ?????? ????????? ?????? ?? ???? ????????? ??????????? ????????
procedure QuickSort(A: array of TFoundTile; l,r: integer);
  var
  i, j: Integer;
  x, y: TFoundTile;

  begin
    i := l;
    j := r;
    x := A[((l + r) div 2)];
    repeat
      while vector_length(A[i]) < vector_length(x) do inc(i);
      while vector_length(x) < vector_length(A[j]) do dec(j);
      if not (i>j) then
        begin
          y:= A[i];
          A[i]:= A[j];
          A[j]:= y;
          inc(i);
          dec(j);
        end;
    until i>j;
    if l < j then QuickSort(ChopTilesArray, l,j);
    if i < r then QuickSort(ChopTilesArray, i,r);
  end;

// ???????, ????????? ?????????, ????????? ???????
procedure MarkTrees;
  begin
    SearchTree;
    AddToSystemJournal('MarkTrees: ' + IntToStr(Length(TempFoundTilesArray)));
    ClearDuplicate;
    QuickSort(ChopTilesArray, 0, Length(ChopTilesArray) - 1);
  end;

// ?????????
procedure DropLog;
 var g : integer;
 LogCol : Array [0..20] of Word;
Begin
 finddistance := 2;
 CheckLag (30000);
 AddToSystemJournal('DropLog');
 LogCol[0] := $0000; // Log
 LogCol[1] := $0362; // Jade
 LogCol[2] := $010D; // Oak
 LogCol[3] := $0094; // Karund
 LogCol[4] := $01B0; // Leshram
 LogCol[5] := $01A2; // Tourmalite
 LogCol[6] := $0026; // Emerint
 LogCol[7] := $00CB; // Legrand
 LogCol[8] := $094A; // Solmur
 LogCol[9] := $092B; // Kleor
 LogCol[10] := $0931; // Logradoom
 LogCol[11] := $093F; // Vialonit
 LogCol[12] := $0074; // Stardust
 LogCol[13] := $006F; // Pyronil
 LogCol[14] := $09EF; // Mystic
 LogCol[15] := $0119; // Elvin
 LogCol[16] := $000B; // Elkris
 for g := 0 to 16 do
 begin
 CheckLag (30000);
 FindTypeEx(LogType,LogCol[g],backpack,false);
 if FindCount > 0 then
  begin
   stack(LogType,LogCol[g]);
   CheckLag (30000);
   wait(1000);
  end;
 end;
 FindTypeEx(DeadWoods,$ffff,backpack,false);
 if FindCount > 0 then
  begin
   stack(DeadWoods,$ffff);
   CheckLag (30000);
   wait(1000);
  end;
 hungry (1,-1);
 wait(500);
 Addtosystemjournal('=========================================');
 FindType(LogType,ground);
 Addtosystemjournal('total logs - '+intToStr(findfullquantity));
 FindTypeEx(LogType,$0000,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Log - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$0362,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Jade - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$010D,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Oak - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$0094,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Karund - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$01B0,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Leshram - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$01A2,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Tourmalite - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$0026,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Emerint - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$00CB,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Legrand - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$094A,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Solmur - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$092B,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Kleor - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$0931,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Logradoom - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$093F,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Vialonit - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$0074,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Stardust - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$006F,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Pyronil - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$09EF,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Mystic - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$0119,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Elvin - '+intToStr(findfullquantity));
 end;
 FindTypeEx(LogType,$000B,ground,False);
 if FindCount > 0 then
 begin
 Addtosystemjournal('Elkris - '+intToStr(findfullquantity));
 end;
 
FindType(CopperType,ground);
Addtosystemjournal('Copper-ingots: ' + intToStr(findfullquantity));
FindType(eda,ground);
Addtosystemjournal('Fish-steaks: ' + intToStr(findfullquantity));
Addtosystemjournal('=========================================');
 
End;

procedure resself;
begin
AddToSystemJournal('Resself. Enter');
WaitConnection(3000);
checksave;
Wait(1000);
WaitGump('1');
setwarmode(true);
while dead do wait(1000);
if findtype($2006,ground) > 0 then begin
if targetpresent then canceltarget;
waittargetobject(finditem);
useobject(findtype($0F51,ground));wait(1000);
end;
hungry(1,ground);
Wait(30000);
UOSay('Thx');
AddToSystemJournal('Resself. Exit');
end;

// GotoOnBoad
procedure GotoOnBoad;
begin
if (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) > 0 then
  begin
   repeat
   CheckLag (30000);
   NewMoveXY(vozleX,vozleY, True, 0, True);
   CheckLag (30000);
   wait(1000);
   until (Dist(GetX(Self), GetY(Self), vozleX, vozleY)) = 0;
if (Dead) then
  begin
   repeat
   CheckLag (30000);
   NewMoveXY(resX,resY, True, 0, True);
   CheckLag (30000);
   wait(500);
   WaitGump('1');
   until (Dist(GetX(Self), GetY(Self), resX, resY)) = 0;
   while dead do resself;
   repeat
   CheckLag (30000);
   SetWarMode(false);
   NewMoveXY(vozleX,vozleY, True, 0, True);
   CheckLag (30000);
   wait(1000);
   until (Dist(GetX(Self), GetY(Self), vozleX, vozleY)) = 0;
  end;
   repeat
   UseObject(Trap);
   CheckLag (30000);
   wait(1000);
   UseObject(Trap);
   CheckLag (30000);
   NewMoveXY(lodkaX,lodkaY, True, 0, True);
   CheckLag (30000);
   wait(1000);
   until (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) = 0;
  end;
if (Dist(GetX(Self), GetY(Self), lodkaX, lodkaY)) = 0 then
  begin
   CheckDead;
   Hungry(1,ground);
   DropLog;
   CheckAxe;
   checkfish;
   checkcoord;
  end;
end;

procedure CheckEquip;
 Var EquipAxe : Cardinal;
 begin
 if (GetType(ObjAtLayer(LhandLayer)) <> AxeType) then
  begin
   Disarm;
   CheckLag (30000);
   wait(500);
   FindType(AxeType, Backpack);
   if (FindCount > 0) then
    begin
     EquipAxe := finditem;
     Equip(LhandLayer, EquipAxe);
     CheckLag (30000);
     wait(500);
    end
    else GotoOnBoad;
   end;
 end;

procedure BrosaemMusor;
 var t : integer;
 Cvet : Array [0..7] of Word;
 Begin
  finddistance := 2;
  CheckLag (30000);
//  AddToSystemJournal('Sbrasivaem musor!');
  Cvet[0] := $0000; // Log
  Cvet[1] := $0362; // Jade
  Cvet[2] := $010D; // Oak
  Cvet[3] := $0094; // Karund
  Cvet[4] := $01B0; // Leshram
  Cvet[5] := $01A2; // Tourmalite 
  Cvet[6] := $0026; // Emerint
  Cvet[7] := $00CB; // Legrand
  for t := 0 to 7 do
   begin
   CheckLag (30000);
   FindTypeEx(LogType,Cvet[t],backpack,false);
   if FindCount > 0 then
     begin
     CheckLag(30000);
     MoveItem(finditem, 0, ground, 0, 0, 0);
     wait(300);
     end;
   end;
  CheckEquip;
 end;

// ????? ??????
function LumbCurTree(tile,x,y,z : Integer) : Boolean;
  // ????? ????????? ????. ?????????? false ???? ??????? ??? ??? ?????.
  var
  q, m1, m2, m3, m4, NextTree : integer;

  begin
   Result := true;
    repeat
     Eat;
     
  // tyt esli nado mojzgo ubrat komment s koda i uzat spirit speak ili arms lor craftom pered rubkoi
//     UseSkill('Spirit Speak');
//     Wait(100);
     
     
//     If TargetPresent Then CancelTarget;
//     FindType(AxeType, Backpack);
//     if (FindCount > 0) then
//      begin
//       WaitTargetobject(FindType(rb, Backpack));
//       UseSkill('Item ID');
//       CheckLag (30000);
//       Wait(100);
//        If TargetPresent Then begin
//         TargetToObject(FindType(rb, Backpack));
//         CheckLag (30000);
//         Wait(100);
//        end;
//      end;

//     If TargetPresent Then CancelTarget;
//     FindType(AxeType, Backpack);
//     if (FindCount > 0) then
//      begin
//       WaitTargetobject(FindType(AxeType, Backpack));
//       UseSkill('Arms Lore');
//       CheckLag (30000);
//       Wait(500);
//        If TargetPresent Then begin
//         TargetToObject(FindType(AxeType, Backpack));
//         CheckLag (30000);
//         Wait(500);
//        end;
//      end;
      
     CheckLag (30000);
     If TargetPresent Then CancelTarget;
     if (GetType(ObjAtLayer(LhandLayer)) = AxeType) then
     CheckEquip;
     if WarMode = true then SetWarMode(false);
     if TargetPresent then CancelTarget;
     ctime := Now;
     CheckLag (30000);
     CheckEquip;
     wait(500);
     CheckLag (30000);
     WaitTargetTile(tile, x, y, z);
     UseObject(ObjAtLayer(LhandLayer));
     CheckLag (30000);
     q := 0;
      repeat
       wait(100);
       q := q + 1;
       checksave;
       m1 := InJournalBetweenTimes(Msg1, ctime, Now);
       m2 := InJournalBetweenTimes(Msg2, ctime, Now);
       m3 := InJournalBetweenTimes(Msg3, ctime, Now);
       m4 := InJournalBetweenTimes(Msg4, ctime, Now);
      until (m1<>-1) or (m2<>-1) or (m3<>-1) or (m4<>-1) or Dead or (q > 450);
       BrosaemMusor; // Esli hochesh skidivat derevo?!??
      if Dead or (Weight > MyMaxWeight) then
      begin
       Result := false;
       exit;
      end;
     if (q > 200) then NextTree := NextTree + 1;
    until (m1<>-1) OR (m2<>-1) OR (m3<>-1) OR (m4<>-1)OR (NextTree > 3);
   if NextTree >= 3 then NextTree := 0;
  end;

// ??????? ???????
Begin
SetARStatus(True);
Addtosystemjournal('Begin.');
  BrosaemMusor;
  GotoOnBoad;
  InitTTilesArray;
  InitSystem;
  MarkTrees;

 while (not dead) and (connected) do
    begin
     for i:= 0 to Length(ChopTilesArray) - 1 do
      begin
        Disarm;
        NewMoveXY(ChopTilesArray[i].x, ChopTilesArray[i].y, true, 1, true);
        Addtosystemjournal('Tile Number: '+intToStr(i+1)+'.');
        if not LumbCurTree(ChopTilesArray[i].tile, ChopTilesArray[i].x, ChopTilesArray[i].y, ChopTilesArray[i].z) then GotoOnBoad;
      end;
    end;
End.

Re: Подскажите ламбер плз

Добавлено: 18 сен 2024, 20:55
Carlpots
спасибо большое

Re: Подскажите ламбер плз

Добавлено: 19 сен 2024, 11:47
Carlpots
Nightwolf писал(а): ↑18 сен 2024, 19:32 слушай не охота рыться шо ты там наклацал, давай вот рабочий скрипт возьмешь свои координаты / ид трапа поменяешь?


Compiler: [Error] (C:\Users\user\Desktop\rw35w65w6w6w36w.txt at 155:1): Unknown identifier 'FullDisconnect'
14:44:40:247 [Chibo Xiao]: Compilation failed
14
Часовой пояс: UTC
Страница 1 из 3

Создано на основе phpBB® Forum Software © phpBB Limited

Русская поддержка phpBB