допилить до совершенства :)

[Kallish]

Суть скрипта такая, есть голый чар с максимальным минингом. бегает от крыльца дома до шахты и обратно, выкапывает определнную руду, бежит обратно, убивают - идет воскрешаться, и по новой. Нужно допилить не понимаю как куда и какие процедуры вставить, написать то я их смогу.
1) убийство элементала(умер-воскресился-прибежал в шахту-начал атаковать элементала-умер и по новой) до тех пор пока элементал не будет мертв.
2) Все возможные чек-деды в уязвимых частях скрипта
3) возможность копать в несколько окон, что бы они друг-от-друга не "подвисали" когда 1) чар сбрасывает руду, 2) чар выкладывает руду по среди поля.

Code: Select all

program MiningInMinoc;
//NewMoveXY(GetX(Healer),GetY(Healer),true,1,true);
const
MineStartX = 2566; //Центер пещеры по оси X
MineStartY = 486; //Центер пещеры по оси Y
Pickaxe = $0E85; //Type кирки (сейчас Hammer Pick)
ResCount = $4709B654; //Контейнер с припасами (еда, Recall scroll'ы, кирки)
MaxVes = 200; //Максимальный вес при котором лететь домой на разгрузку
Sunduk = $501B787D;
targetk = $010E8F20;


var
a : TFoundTilesArray;
i, b, Error : integer;
StartX, StartY : Word;
TyleType : array [0..24] of cardinal;
ctime, mdtime, gtime : TDateTime;
{$Include 'all.inc'}


Procedure init;
var 
dot:array [0..3] of TFoundTile;
ctimeq:TDatetime;
dotResp: integer;
begin
while dead do 
begin
NewMoveXY(2451, 93, true, 1, true);
ctimeq := Now;
dotResp:=0;
ctimeq := Now;

dot[0].X:=2462;      //точки которые будем обходить
dot[0].Y:=103;
dot[1].X:=2471;
dot[1].Y:=73;
dot[2].X:=2482;
dot[2].Y:=88;
dot[3].X:=2467;
dot[3].Y:=86;
waitgump('1')
AddToSystemJournal('Жертва: '+GetName(targetk)+'.ID: '+inttohex(targetk,8)+'.Х: '+inttostr(GetX(targetk))+'.Y: '+inttostr(GetY(targetk))+'.Z:'+inttostr(GetZ(targetk))+'. дистанция: ' +inttostr(GetDistance(targetk)));

AddToSystemJournal('My person: '+GetName(Self)+'.Х: '+inttostr(GetX(Self))+'.Y: '+inttostr(GetY(Self))+'.Z:'+inttostr(GetZ(Self)));
NewMoveXY(GetX(targetk),GetY(targetk),true,2,true);
end;
end;

  

procedure TPMine;
begin
init;
 if not ((GetX(self) = 2440) and (GetY(self) = 94)) then
begin
NewMoveXY(2440,94,True,1,True);
  wait(1000)
end;
end;
 
procedure OpenBackpack;
begin
  if not Connected then exit;
    if (LastContainer <> Backpack) and (dead = false) then
    begin
      repeat
        if not Connected then exit;
        Checksave;
        UseObject(Backpack);
        wait(1000);
      until LastContainer = Backpack;
    end;
end; 

procedure DropRes;
var
i, BID, GID, BCount, GCount, MCount, BColor : integer;
Color : array [0..13] of cardinal;
begin
   if not ((GetX(self) = 2468) and (GetY(self) = 116)) then
begin
OpenBackpack;
NewMoveXY(2468,116,True,1,True);
  FindTypeEx($19B9, $FFFF, Backpack, false);
  if FindCount > 0 then
    begin
      init;
      Color[0] := $0488; // purtit
      Color[1] := $0698; // deep 
      Color[2] := $05D2; // aqua
      Color[3] := $0482; // silver
      Color[4] := $0253; // valorit
      Color[5] := $0949; // druidsilver
      Color[6] := $0577; // air
      Color[7] := $051E; // celestit
      Color[8] := $0457; // ereirit
      Color[9] := $08EA; //ppk
      Color[10] := $052D; //mythril
      Color[11] := $0944; //sun
      Color[12] := $0942; //wyrm
      Color[13] := $0481; //adamant
      for i := 0 to 13 do
        begin
          FindTypeEx($19B9, Color[i], Backpack, false);
          if FindCount > 0 then
            begin
              BCount := FindQuantity;
              BID := finditem;
              repeat
                FindTypeEx($19B9, Color[i], Ground, false);
                if FindQuantity >= 60000 then Ignore(finditem);
              until FindQuantity < 60000;
              if FindQuantity = 0 then
                begin
                  MoveItem(BID, 0, Ground, GetX(self)+1,GetY(self),GetZ(self));
                end; 
              if FindQuantity < 60000 then
                begin
                  GCount := FindQuantity;
                  GID := finditem;
                end;
              if GCount > 0 then
                begin
                  MCount := 60000 - GCount;
                  if MCount >= BCount then MCount := 0;
                  MoveItem(BID, MCount, GID, 0,0,0);
                end;
            end;
        end;
      repeat
        FindTypeEx($19B9, $FFFF, Backpack, false);
        if FindCount > 0 then
          begin
            BCount := FindQuantity;
            BID := finditem;
            BColor := GetColor(finditem);
          end;
        repeat
          FindTypeEx($19B9, BColor, Ground, false);
          if FindQuantity >= 60000 then Ignore(finditem);
        until FindQuantity < 60000;
        if FindQuantity = 0 then
          begin
            MoveItem(BID, 0, Ground, GetX(self),GetY(self),GetZ(self));
            GCount := 0;
          end; 
        if (FindQuantity < 60000) and (FindQuantity > 0) then
          begin
            GCount := FindQuantity;
            GID := finditem;
          end;
        if GCount > 0 then
          begin
            MCount := 60000 - GCount;
            if MCount >= BCount then MCount := 0;
            MoveItem(BID, MCount, GID, 0,0,0);
          end;
        FindTypeEx($19B9, $FFFF, Backpack, false);
        init;
      until FindCount <= 0;
    end;
end;
end;



procedure CheckWeight;
var
i, BID, GID, BCount, GCount, MCount, BColor, rx ,ry : integer;
Color2 : array [0..13] of cardinal;
begin
init;
  FindTypeEx($19B9, $FFFF, Backpack, false);
  if FindCount > 0 then
    begin
      Color2[0] := $0488; // purtit
      Color2[1] := $0698; // deep 
      Color2[2] := $05D2; // aqua
      Color2[3] := $0482; // silver
      Color2[4] := $0253; // valorit
      Color2[5] := $0949; // druidsilver
      Color2[6] := $0577; // air
      Color2[7] := $051E; // celestit
      Color2[8] := $0457; // ereirit
      Color2[9] := $08EA; //ppk
      Color2[10] := $052D; //mythril
      Color2[11] := $0944; //sun
      Color2[12] := $0942; //wyrm
      Color2[13] := $0481; //adamant
      for i := 0 to 13 do
        begin
          FindTypeEx($19B9, Color2[i], Backpack, false);
          if FindCount > 0 then
      begin
      rx := GetX(self);
      ry := GetY(self);
      DropRes;
      TPMine;
      NewMoveXY(rx, ry, True, 0, True);   
    end; 
end;
end;
end;




procedure StartMining;
var
i, t : integer;
begin
  for i := 0 to b do
    begin
      if a[i].Z = GetZ(Self) then
        begin
          init;
          checksave;
          CheckWeight;
          NewMoveXY(a[i].X, a[i].Y, True, 2, False);
          repeat
           
            SetWarMode(true); 
            uosay('.bandage self');
            init;
            UseObject(Backpack);
            UseObject(FindType(Pickaxe,backpack));
            t := 0;
            repeat
              wait(50);
              checksave;
              t := t + 1;
            until TargetPresent or dead or (t >= 100);            
            ctime := Now;
            TargetToTile(a[i].Tile, a[i].X, a[i].Y, a[i].Z);
            CheckSave;
            WaitJournalLine(ctime, 'Points|There is no ore here to mine|Cancelled|That is too far away', 5000);            
            if (InJournalBetweenTimes('There is no ore here to mine|Cancelled|That is too far away', ctime, Now) <> -1) or dead then
              begin
                init;
                break;
              end;
            if InJournalBetweenTimes('Points|Ouch!', ctime, Now) <> -1 then
              begin
                repeat
                  wait(100)
                   init;
                  CheckSave;
                until (InJournalBetweenTimes('There is no ore here to mine|Cancelled|That is too far away|You cannot|That is too far away', ctime, Now) <> -1) or dead;
              end;
            init;
          until false;
        end;
    end;
end;

begin
SetARStatus(true); //автореконектер
SetPauseScriptOnDisconnectStatus(true); //при дисконнекте, все запущенные скрипты встанут на паузу
FindDistance := 100; 
FindVertical := 1;
Error := 0;
mdtime := Now;
gtime := Now;
TyleType[0] := 1339;
  TyleType[1] := 1340;
  TyleType[2] := 1341;
  TyleType[3] := 1342;
  TyleType[4] := 1343;
  TyleType[5] := 1344;
  TyleType[6] := 1345;
  TyleType[7] := 1346;
  TyleType[8] := 1347;
  TyleType[9] := 1348;
  TyleType[10] := 1349;
  TyleType[11] := 1350;
  TyleType[12] := 1351;
  TyleType[13] := 1352;
  TyleType[14] := 1353;
  TyleType[15] := 1354;
  TyleType[16] := 1355;
  TyleType[17] := 1356;
  TyleType[18] := 1357;
  TyleType[19] := 1358;
  TyleType[20] := 1359;
  TyleType[21] := 1386;
  TyleType[22] := 1361;
  TyleType[23] := 1362;
  TyleType[24] := 1363;

repeat
init;
DropRes;
init;
TPMine;
if Error = 1 then
  begin
    SetARStatus(false);
    SetPauseScriptOnDisconnectStatus(false);
    exit;
  end;
NewMoveXY(MineStartX,MineStartY,True,0,True);
StartX := GetX(Self);
StartY := GetY(Self);
for i := 0 to 24 do
  begin
    b:= GetStaticTilesArray(StartX-30,StartY-30,StartX+30,StartY+30, 0, TyleType[i], a);
    if b > 1 then
      begin
        if Error = 1 then
          begin
            SetARStatus(false);
            SetPauseScriptOnDisconnectStatus(false);
            exit;
          end;
        StartMining;
      end;
  end;
  
init;
DropRes;
until false
END.

[drabadan]

1. Ну почему так сложно запилить скрипт в тег spoiler, зачем ети простыни тут...
2. Написать смогу - а вставить нет... У всех других человеков все в обратном порядке получается, сначало учатся вставлять - а потом уже писать...
3. Помысли логически, в скрипте есть 100500 строк кода, они все - это цикл. Какие-то строчки кода выполняются чаще других, подциклы в основном цыкле. Например, процедура копки будет чаще выполнятся чем убийство елементаля, значит и проверять там будет лучше чем в каком-то другом участке скрипта.

я приведу пример своей процедуры копки, сможешь посмотреть как у меня строиятся все проверки, может чем-то поможет. Я не претендую ни на что - просто сравни, вдруг чего - нового откроется!

Скрипт в спойлере

Code: Select all

procedure MinTileSpot(Idx : Integer);
var
    i, k : Integer;
    msgFizzle, msgEnd : String;
    cTime : TDateTime;    
begin
    msgFizzle := 'You put |You loosen ';
    msgEnd := 'is nothing| too far| mining in rock| cannot mine| no line| reach| not to mine| try mining';
    if Dist(GetX(self), GetY(self), MinTiles_Array[Idx].x, MinTiles_Array[Idx].y) > 2 then 
        NewMoveXY(MinTiles_Array[Idx].x, MinTiles_Array[Idx].y, true, 1, true);
    for k := 0 to 4 do
        begin
            if IsMob > 0 then KillMob(IsMob);
            if FlagPk then exit;
            if WarMode then SetWarMode(False);
            if FindGM then GMFound;
            //if not Hidden then CheckHide;     
            if IsGump then GumpHandling;
            if RunPk then FlagPk := True;    
            if UseType(Pickaxe_Type, $FFFF) = 0 then 
                UseType(Shovel_Type, $FFFF);
            CheckLag(30000);
            if not WaitForTarget(3000) then
                if UseType(Pickaxe_Type, $FFFF) = 0 then 
                    UseType(Shovel_Type, $FFFF);
            CheckLag(30000);
            if not WaitForTarget(3000) then 
                begin
                    ClientPrint('No pickaxes or shovels found...');
                    exit;
                end
            else
                begin
                    cTime := Now;
                    TargetToTile(MinTiles_Array[Idx].Tile, MinTiles_Array[Idx].x, MinTiles_Array[Idx].y, MinTiles_Array[Idx].z);                    
                    for i := 0 to 55 do
                        begin
                            if IsMob > 0 then KillMob(IsMob);
                            if RunPk then 
                                begin
                                    FlagPk := True;
                                    break;
                                end;
                            Wait(100);
                            CheckLag(30000);
                            if (InJournalBetweenTimes(msgFizzle, cTime, Now) <> -1) then break;
                            if (InJournalBetweenTimes(msgEnd, cTime, Now) <> -1) then exit;
                        end;
                end;
        end;
    ClientPrint('Tile finished.');    
end;