Code: Select all
Program LumberDRW;
{$Include 'all.inc'}
type LumbRecord = Record
x,y,tt,tx,ty,tz : integer;
end;
var
LumberDim : array [0..5000] of LumbRecord;
ResDim : array [0..5000] of LumbRecord;
MaxPosL, MaxPosR, k : integer; // длины соответствующих массивов
LumberFlag : Boolean; // true - работаем, false - нет (разгрузка или смерть)
ctime : TDateTime;
CheckSWSTimer : TDateTime;
const
FMoveArrMax = 300; // ставь здесь больше, если твой чар ходит на дистанции больше 13 тайлов или вокруг чара очень много препятствий. Если препятствий на пути мало, то можно оставить как есть.
var
PrognosisX, PrognosisY, FMoveArrCount : integer;
FMoveArr : array [1..FMoveArrMax] of array [1..2] of smallint;
const
Msg1 = 'kkik';
Msg2 = 'reach this';
Msg3 = 'fail to';
Msg4 = 'no wood here to chop';
Msg5 = 'There is nothing';
Msg6 = 'OOPS !!!';
AxeType1 = $0F43;
AxeType2 = $0F43;
MaxWeight = 750;
MaxFizzle = 1;
l_rails = 'c:\shepka.txt';
logType = $1BDD;
Sunduk_log = $4ACF5D9B;
r_lumb = 16; // Number of rune to Lumber 2 (no change)
r_home = 17; // Number of rune to home 1 (no change)
runebook = $4ADE5DCF; // Runebook
procedure CheckDead;
Begin
if Dead then
begin
AddToSystemJournal('Персонаж мертв: '+TimeToStr(now));
//FullDisconnect;
end
end;
procedure ents;
var TimeInterno : TDateTime;
begin
ClearJournal;
TimeInterno := Now;
Addtosystemjournal('Найден ЭНТ для продолжение напишите start');
UOSay('\w Galiano: Ents!!! x:'+IntToStr(GetX(self))+' y:'+IntToStr(GetY(self)));
repeat
wait(2000);
until (inJournalBetweenTimes('start', TimeInterno, Now) >= 0);
wait(2000);
ClearJournal;
end;
procedure GetLumberRail(s : String; WPos : Integer; flag : Boolean);
// flag - true - маршрут для ламбера, false - маршрут для реса
begin
s := s + ' ';
if flag then
begin
LumberDim[WPos].tt := StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
LumberDim[WPos].tx := StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
LumberDim[WPos].ty := StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
end
else
begin
ResDim[WPos].tt := StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
ResDim[WPos].tx := StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
ResDim[WPos].ty := StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
end;
end;
procedure GetRail(FileNam : String; Flagoffile : boolean);
var
List : TStringList;
i : integer;
begin
List := TStringList.Create;
List.LoadFromFile(FileNam);
for i := 0 to List.Count-1 do GetLumberRail(List.strings[i],i,FlagOfFile);
if Flagoffile then MaxPosL := i
else MaxPosR := i;
end;
function CheckAxe : Boolean;
// проверяем, есть ли топор у чара в паке или на нужном слое.
// если ее нет - открываем сундук и мешок, берем топор. Если топора нет
// в мешке - выход.
var tmpser : Cardinal;
begin
Result := true;
waitconnection(3000);
if (ObjAtLayerEx(LhandLayer,self) <> 0) or (count(AxeType1)<>0) or (count(AxeType2)<>0) then exit;
// нет у чара топора
repeat
UseObject(Sunduk_log);
wait(1000);
checksave;
tmpser := findtype(AxeType1,Sunduk_log);
if tmpser = 0 then tmpser := findtype(AxeType2,Sunduk_log);
if tmpser <> 0 then
begin
Grab(tmpser,1);
wait(1000);
checksave;
end;
until (count(AxeType1)<>0) or (count(AxeType2)<>0);
end;
procedure dlog(logString,fname : string);
var
ls : TStringList;
begin
ls := TSTringList.Create();
try
ls.loadFromFile(fname);
except
//создаем файл, если нету
ls.saveToFile(fname);
end;
ls.add(logString);
ls.saveToFile(fname)
ls.free();
end;
procedure DropLog;
var tmpid : Cardinal;
begin
dlog('Разгрузка логов: ' + DateTimeToStr(Now),'lumber.log');
CheckDead;
checksave;
repeat
tmpid := Findtype(logType,backpack);
waitconnection(3000);
checksave;
MoveItem(tmpid,GetQuantity(tmpid),Sunduk_log,0,0,0);
wait(1000);
checksave;
until tmpid = 0;
wait(1000);
useobject(Sunduk_log);
wait(1000);
Hungry(1,Sunduk_log);
wait(1000);
checksave;
findtype($1F4C,Sunduk_log);
if (findcount > 0) then MoveItems(Sunduk_log, $1F4C, $FFFF, runebook, 0, 0, 0, 500)
else
begin
Addtosystemjournal('KoH4uJIuCb scrool recall');
end;
wait(1000);
checksave;
MoveItems(Backpack, $1F4C, $FFFF, Sunduk_log, 0, 0, 0, 500);
wait(1000);
checksave;
End;
procedure CheckHide;
begin
if Hidden then exit;
repeat
if WarMode = true then SetWarMode(false);
AddToSystemJournal('Прячемся...');
UseSkill('Hiding');
wait(4500);
checksave;
until Hidden or (not Connected);
end;
function LumbCurTree(tile,x,y,z : Integer) : Boolean;
// рубим указанный тайл. Возвращаем false если перевес или чар мертв.
var q, m1, m2, m3, m4, m5, m6, CountFizzle : integer;
begin
if (ObjAtLayer(LHandLayer) = 0) then equipt(LHandLayer,AxeType1);
Result := true;
CountFizzle := 0;
repeat
// CheckHide;
checkdead;
if WarMode = true then SetWarMode(false);
if TargetPresent then CancelTarget;
ctime := Now;
if Dead then begin Result := false; exit; end;
wait(2000);
UseObject(ObjAtLayer(LhandLayer));
WaitForTarget(5000);
If TargetPresent then TargetToTile(tile, x, y, z);
q := 0;
repeat
wait(1000);
q := q + 1;
checksave;
m1 := InJournalBetweenTimes(Msg1, ctime, Now);
m2 := InJournalBetweenTimes(Msg2, ctime, Now);
m3 := InJournalBetweenTimes(Msg3, ctime, Now);
m4 := InJournalBetweenTimes(Msg4, ctime, Now);
m5 := InJournalBetweenTimes(Msg5, ctime, Now);
m6 := InJournalBetweenTimes(Msg6, ctime, Now);
until (m1<>-1) or (m2<>-1) or (m3<>-1) or (m4<>-1) or (m5<>-1) or (m6<>-1) or Dead or (q = 60);
if (m1<>-1) or (m3<>-1) or (q = 60) then CountFizzle := CountFizzle + 1;
if (m6<>-1) then ents;
if Dead or (Weight > MaxWeight) then begin Result := false; exit; end;
until (m5<>-1) or (m4<>-1) OR (CountFizzle = MaxFizzle);
end;
procedure recal_rb(rune : integer);
var tmpr : Integer;
mx, my, k, Res : Integer;
begin
repeat
checksave;
disarm;
Res := 0;
CheckDead;
AddToSystemJournal('Try to recall');
tmpr := rune;
waitgump(IntToStr(tmpr));
wait(1000)
UseObject(runebook);
mx := GetX(self);
my := GetY(self);
k := 0;
repeat
wait(500)
k := k + 1;
CheckSave;
until (mx<>GetX(self)) or (my<>GetY(self)) or Dead or (k = 20)
if (mx<>GetX(self)) or (my<>GetY(self)) then Res := 1;
until Res = 1;
end;
procedure checkweight;
begin
if (Weight > MaxWeight) then
begin
AddToSystemJournal('Полный');
recal_rb(r_home);
DropLog;
recal_rb(r_lumb);
end;
end;
procedure InitCheckFlow;
begin
CheckSWSTimer := Now;
end;
function SWSSoon : boolean;
begin
result := (GetGlobal('stealth', 'Saving World State') = '1');
end;
function CheckFlow : integer;
var
delay : integer;
begin
delay := timer;
checksave;
WaitConnection(5000);
result := timer - delay;
end;
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 + CheckFlow;
lastX := GetX(self); lastY := GetY(self);
if TryToMove(Dir, true) 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;
Begin
GetRail(l_rails,true);
AddToSystemJournal('Маршрут ' + l_rails + ' загружен');
repeat
CheckDead;
if Dead then LumberFlag := false else LumberFlag := true;
if LumberFlag then
begin
recal_rb(r_lumb);
if not CheckAxe then exit;
For k := 0 to MaxPosL-1 do
begin
// идем по маршруту
AddToSystemJournal('Переход к дереву #' + inttostr(k+1)+ ' x:'+inttostr(LumberDim[k].tx)+' y:'+inttostr(LumberDim[k].ty));
_move(LumberDim[k].tx, LumberDim[k].ty, 1);
AddToSystemJournal('Переход окончен');
if LumberFlag and (LumberDim[k].tt <> 0) then
// CheckHide;
AddToSystemJournal('Начинаем рубить дерево #' + inttostr(k+1));
LumberFlag := LumbCurTree(LumberDim[k].tt,LumberDim[k].tx,LumberDim[k].ty,GetZ(self));
checkweight;
end;
end;
until False;
End.