Code: Select all
12:58:21:309] System: Could not add item to stack.
[12:58:21:310] System: Some inspecific error when moving item!
мининг песок/глина
Code: Select all
program MiningClay;
var
STATE, mpx, mpy, lowX, lowY, highX, highY: integer;
hynger_timer: TDateTime;
const
on_boatX = 1591;
on_boatY = 3534;
near_boatX = 1594;
near_boatY = 3534;
mine_pointX = 1598;
mine_pointY = 3533;
trap = $623F250C;
critical_weight = 100;
radius = 3;
glina_type = $0EED;
//glinj_type = $19B8;
PickType = $0E85;
PickGump = '3717';
Tinktype = $1EB9;
CopperType = $1BF2;
// STATE SCRIPT
STATE_MINING = 100;
STATE_GO_ON_BOAT = 101;
STATE_ON_BOAT = 102;
STATE_NEAR_BOAT = 103;
//
{$Include 'all.inc'}
function CheckEquipt(equip_type:word; equip_layer:byte): boolean;
begin
if not Connected then
WaitConnection(3000);
result:= Equipt(equip_layer, equip_type);
wait(500);
end;
// написал Somebody. ICQ: 475728522 e-mail: [email protected]
// Реализация алгоритма "надёжной трассировки"
// http://pmg.org.ru/ai/stout.htm#robust_trace
const
FMoveArrMax = 300; // ставь здесь больше, если твой чар ходит на дистанции больше 13 тайлов или вокруг чара очень много препятствий. Если препятствий на пути мало, то можно оставить как есть.
var
PrognosisX, PrognosisY, FMoveArrCount : integer;
FMoveArr : array [1..FMoveArrMax] of array [1..2] of smallint;
Function Abs(A: integer): integer;
Begin
If A>=0 then result:=A
Else result:=0-A;
End;
function SetDirection(x, y : integer) : integer;
var
MyX,MyY,DiffX,DiffY,GoDir: integer;
Begin
MyX:=GetX(self);
MyY:=GetY(self);
DiffX:=Abs(MyX-x);
DiffY:=Abs(MyY-y);
if (DiffX/(DiffY+0.1))>=2 then
begin
if (MyX>X) then
GoDir:=6
else
GoDir:=2;
end
else
if (DiffY/(DiffX+0.1))>=2 then
begin
if (MyY>Y) then
GoDir:=0
else
GoDir:=4;
end
else
if (MyX>X) and (MyY>Y) then GoDir:=7
else
if (MyX>X) and (MyY<Y) then GoDir:=5
else
if (MyX<X) and (MyY>Y) then GoDir:=1
else
if (MyX<X) and (MyY<Y) then GoDir:=3;
result:=GoDir;
end;
procedure CalcPrognosis(Dir : integer);
begin
if (Dir = 1) or (Dir = 2) or (Dir = 3) then PrognosisX := GetX(self) + 1;
if (Dir = 5) or (Dir = 6) or (Dir = 7) then PrognosisX := GetX(self) - 1;
if (Dir = 0) or (Dir = 4) then PrognosisX := GetX(self);
if (Dir = 3) or (Dir = 4) or (Dir = 5) then PrognosisY := GetY(self) + 1;
if (Dir = 7) or (Dir = 0) or (Dir = 1) then PrognosisY := GetY(self) - 1;
if (Dir = 2) or (Dir = 6) then PrognosisY := GetY(self);
end;
function TryToMove(Direction : integer; RunFlag : boolean) : boolean;
begin
if GetDirection(self) <> Direction then Raw_Move(Direction, RunFlag);
result := Raw_Move(Direction, RunFlag);
end;
function WrongMove(x, y : integer) : boolean;
var
i : integer;
begin
result := false;
if FMoveArrCount = 0 then exit;
for i := 1 to FMoveArrCount do
begin
if (x = FMoveArr[i][1]) and (y = FMoveArr[i][2]) then
begin
result := true;
exit;
end;
end;
end;
function Min(x,y: integer): integer;
begin
if x>y then Result:=y else Result:=x;
end;
function HEst(x,y: integer): integer;
var dx,dy,Ddx : integer;
begin
dx:= GetX(self)-x;
dy:= GetY(self)-y;
Ddx:= dx-dy;
If dx<0 then dx:=0-dx;
If dy<0 then dy:=0-dy;
If Ddx<0 then Ddx:=0-Ddx;
Result:= min(dx,dy)+Ddx;
end;
procedure SetWrongMove(x, y : integer);
begin
FMoveArrCount := FMoveArrCount + 1;
FMoveArr[FMoveArrCount][1] := x;
FMoveArr[FMoveArrCount][2] := y;
end;
function RewindDir(Dir, c : integer) : integer;
begin
result := Dir + c;
if result < 0 then result := result + 8;
if result > 7 then result := result - 8;
end;
function Move(x, y, tolerance : integer) : boolean;
var
Dir, Dist, lastX, lastY, t, i, timeout : integer;
begin
FMoveArrCount := 0;
Dist := HEst(x, y);
timeout := Dist * 13000; // 13 секунд времени на шаг
t := timer;
while true do
begin
Dist := HEst(x, y);
if Dist <= tolerance then // пришёл
begin
result := true;
exit;
end;
if timer - t > timeout then // провал по таймауту
begin
AddToSystemJournal('Move: Time moved out!');
result := false;
exit;
end;
Dir := SetDirection(x, y);
CalcPrognosis(Dir);
if WrongMove(PrognosisX, PrognosisY) then
begin
for i := 1 to 7 do
begin
Dir := RewindDir(Dir, 1);
CalcPrognosis(Dir);
if not WrongMove(PrognosisX, PrognosisY) then break;
end;
if i = 8 then
begin
AddToSystemJournal('Move: Cannot move');
result := false;
exit;
end;
end;
timeout := timeout + 2
lastX := GetX(self); lastY := GetY(self);
if TryToMove(Dir, false) then SetWrongMove(lastX, lastY) // отсюда чар пришёл
else SetWrongMove(PrognosisX, PrognosisY);
end;
end;
procedure _move(x, y, tolerance : integer);
begin
while not Move(x, y, tolerance) do wait(100);
end;
function GotoOnBoat(locX,locY: integer):integer;
begin
if not Connected then WaitConnection(3000);
while true do begin
CheckStability;
checkdead;
if Move(near_boatX, near_boatY, 0) then begin
repeat
UseObject(Trap);
wait(800);
until (GetX(self) = locX) and (GetY(self) = locY);
result:= STATE_ON_BOAT;
exit;
end;
end;
end;
function GotoNearBoat(locX,locY: integer):integer;
begin
if not Connected then WaitConnection(3000);
wait(1500);
while true do begin
CheckStability;
checkdead;
UseObject(trap);
wait(800);
if Move(near_boatX, near_boatY, 0) then begin
result:= STATE_NEAR_BOAT;
exit;
end;
end;
end;
procedure CheckCooper;
begin
FindType(CopperType, Backpack);
if (FindFullQuantity < 20) then
begin
FindTypeEx(CopperType,$0000,Ground,true);
MoveItem(finditem, 50, Backpack, 0,0,0);
wait(1000);
end;
end;
procedure CheckPick;
begin
CheckSave;
checkdead;
CheckCooper;
if (Count(PickType) < 2) then
begin
repeat
CheckCooper;
//ClearJournal;
WaitGump(PickGump);
WaitTargetobject(findtype(CopperType, Backpack));
UseObject(FindType(TinkType, Ground));
WaitJournalLine(Now, 'You create|destroy|You put', 30000);
wait(1000);
until (Count(PickType) >= 2);
end;
end;
function GotoMiningPoint(mineX, mineY:integer):integer;
begin
if Move(mineX, mineY, 0) then result:= STATE_MINING;
end;
procedure Mining(px,py: integer);
var
pickaxe_id: cardinal;
begin
if not Connected then WaitConnection(3000);
if TargetPresent then CancelTarget;
pickaxe_id:= ObjAtLayer(RHandLayer);
if pickaxe_id <> 0 then begin
UseObject(pickaxe_id);
WaitTargetXYZ(px,py,GetZ(self));
WaitJournalLine(now, 'You must|you fail to find any sand|cannot|no sand here |stop|away|broke', 45000);
begin
if TargetPresent then CancelTarget;
end;
end;
end;
begin
if not Connected then WaitConnection(3000);
hynger_timer:= 0;
addToSystemJournal('Script [ Mining Clay ] by Magros');
setARStatus(true);
checkdead;
// mining location setting
lowX:= (mine_pointX - radius);
lowY:= (mine_pointY - radius);
highX:= (mine_pointX + radius);
highY:= (mine_pointY + radius);
while true do begin
for mpx:= lowX to highX do begin
for mpy:= lowY to highY do begin
// проверка на кирку
CheckStability;
checkdead;
if (GetType(ObjAtLayer(RHandLayer)) = 0) then begin
if not CheckEquipt(PickType, RHandLayer) then STATE:= STATE_GO_ON_BOAT;
// идем на лодку
if STATE = STATE_GO_ON_BOAT then STATE:= GotoOnBoat(on_boatX, on_boatY);
// делаем кирки
if STATE = STATE_ON_BOAT then CheckPick;
end;
// проверка на расположение чара
if (GetX(self) = on_boatX) and (GetY(self) = on_boatY) then begin STATE:= GotoNearBoat(near_boatX, near_boatY);
end else begin
STATE:= STATE_NEAR_BOAT;
end;
// идем на место копки
if STATE = STATE_NEAR_BOAT then begin
STATE:= GotoMiningPoint(mpx,mpy);
// копаем
if STATE = STATE_MINING then Mining(mpx,mpy);
end;
// проверка на вес
if Weight > critical_weight then begin
STATE:= GotoOnBoat(on_boatX, on_boatY);
if STATE = STATE_ON_BOAT then begin
// дропаем глину
Stack(glina_type, $ffff);
wait(2000);
//Stack(glinj_type, $ffff);
if (now > (hynger_timer + (1.0 / 1440 * 10))) then begin
Hungry(1,-1);
hynger_timer:= now;
end;
end;
end;
end;
end;
end;
end.
