+ бывает еще что последняя строка состоит из пробелаscf wrote:Скорее всего не убраны пробелы в конце строк
Forum in READ ONLY mode! All questions and discussions on Discord official server, invite link: https://discord.gg/VxsGzJ7
Скрипт на Lumber. Шард Forest Wars.
-
- Neophyte
- Posts: 30
- Joined: 10.04.2008 22:26
чар берет топор и просто стоит дальше возле сундука. попытался проверить в чем дело, но очень слабо разбераюсь. добавил проверки. 1, 2 и 3 проходит, 4-ой нетуBegin
Regs[1] := $0F85; // ginseng
Regs[2] := $0F88; // Nightshade
Regs[3] := $0F86; // Mandrake Roots
CharRail := 'D:\uo\railes\crystalmaiden.txt';
ResRail := 'D:\uo\railes\res.txt';
GetRail(CharRail,true);
AddToSystemJournal('Маршрут ' + CharRail + ' загружен');
GetRail(ResRail,false);
AddToSystemJournal('Маршрут ' + ResRail + ' загружен');
// Стартуем от сундука
repeat
CheckDead;
if Dead then LumberFlag := false else LumberFlag := true;
if LumberFlag then
AddToSystemJournal('проверка 1');
begin
if not CheckHatchet then exit;
For k := 0 to MaxPosL-1 do
AddToSystemJournal('проверка 2');
begin
// идем по маршруту
repeat
AddToSystemJournal('проверка 3');
// RestoreStamina;
GotoXY(LumberDim[k].x,LumberDim[k].y,0,true);
AddToSystemJournal('проверка 4');
wait(300);
как я понял пробелема с функцией готуXY. даже не знаю что делать, тк слабо разбераюсь. хелп
скрипт почти не менял (убрал хил спиритом и изменил путь к файлу с гейтнейм на, вручную прописанное, имя героя)
шард: найт дей
версия стелса: release candidate 3
update: после многочисленных тестов я выяснил, что чар не стоит возле сундука, а бежит непонятно зачем на "north-west"
-
- Neophyte
- Posts: 30
- Joined: 10.04.2008 22:26
-
- Neophyte
- Posts: 30
- Joined: 10.04.2008 22:26
addtosystemjournal('Идем в: ' + inttostr(x) + ', ' + inttostr(y));
addtosystemjournal('Счас в: ' + inttostr(GetX(self)) + ', ' + inttostr(GetY(self)));
dx := GetX(self) - x; if dx < 0 then dx := 0 - dx;
dy := GetY(self) - y; if dy < 0 then dy := 0 - dy;
if dy > dx then dx := dy;
if dx <= prec then exit;
mx := GetX(self); my := GetY(self);
dx := mx - x; if dx < 0 then dx := 0 - dx;
dy := my - y; if dy < 0 then dy := 0 - dy;
if dy > dx then dx := dy;
if dx <= prec then exit;
if ld = dx then begin
ldc := ldc + 1;
if ldc > 100 then begin addtosystemjournal( 'GotoXY: Cannot reach location!' ); exit; end;
end
else ld := dx;
waitconnection(5000);
addtosystemjournal('Отладка: перед шагом: myx, myy = ' + inttostr(mx) + ', ' + inttostr(my) + ' [GotoXY]');
в GotoXY перед строчками убрал "//" и вот что получилось:
и так повторяет эти строки10:08:55 [xx]: Идем в: 0, 0
10:08:55 [xx]: Счас в: 1980, 156
10:08:55 [xx]: Отладка: перед шагом: myx, myy = 1980, 156 [GotoXY]
10:08:55 [xx]: Идем в: 0, 0
10:08:55 [xx]: Счас в: 1980, 156
10:08:55 [xx]: Отладка: перед шагом: myx, myy = 1980, 156 [GotoXY]
10:09:06 [xx]: Идем в: 0, 0
10:09:06 [xx]: Счас в: 1980, 156
10:09:06 [xx]: Отладка: перед шагом: myx, myy = 1980, 156 [GotoXY]
10:09:17 [xx]: Идем в: 0, 0
10:09:17 [xx]: Счас в: 1980, 156
10:09:17 [xx]: Отладка: перед шагом: myx, myy = 1980, 156 [GotoXY]
ПС: насчет твоей проверки, ты не написал куда ее поставить
Ну вот он и идет в 0, 0 - косяк наверное в файле маршрута
насчет твоих проверок
if LumberFlag then
AddToSystemJournal('проверка 1');
begin
if not CheckHatchet then exit;
For k := 0 to MaxPosL-1 do
AddToSystemJournal('проверка 2');
begin
// идем по маршруту
repeat
AddToSystemJournal('проверка 3');
// RestoreStamina;
GotoXY(LumberDim[k].x,LumberDim[k].y,0,true);
AddToSystemJournal('проверка 4');
wait(300);
красным выделены ошибки, addToSystemJournal надо добавлять _после_ begin, а если ставить до него, то получится что выполнится он один раз после цикла или после срабатывания if.
насчет того, куда воткнуть мою проверку - например вместо твоей 'проверка 3', хотя сейчас и так ясно, что в gotoXY передаются совсем не те координаты.
насчет твоих проверок
if LumberFlag then
AddToSystemJournal('проверка 1');
begin
if not CheckHatchet then exit;
For k := 0 to MaxPosL-1 do
AddToSystemJournal('проверка 2');
begin
// идем по маршруту
repeat
AddToSystemJournal('проверка 3');
// RestoreStamina;
GotoXY(LumberDim[k].x,LumberDim[k].y,0,true);
AddToSystemJournal('проверка 4');
wait(300);
красным выделены ошибки, addToSystemJournal надо добавлять _после_ begin, а если ставить до него, то получится что выполнится он один раз после цикла или после срабатывания if.
насчет того, куда воткнуть мою проверку - например вместо твоей 'проверка 3', хотя сейчас и так ясно, что в gotoXY передаются совсем не те координаты.
-
- Neophyte
- Posts: 30
- Joined: 10.04.2008 22:26
файл маршрута
UPDATE: о чудо, я переставил проверки перед бегином и добавил твою, оно начало ходить. не знаю с чем это связано . но теперь какие-то косяки с рубкой. остановилось на:
файл резуректа1980 156 0 0 0 0
1989 156 0 0 0 0
1989 152 0 0 0 0
1992 152 3290 1992 153 0
1996 152 3299 1996 153 0
2000 155 3299 1996 153 0
2003 153 3288 2004 153 0
2003 150 3283 2004 150 0
2000 145 3296 2000 144 0
1980 156 0 0 0 0
вроде бы все сделал как написано в объяснении скрипта. как я понял, 2 координаты рядом с деревом и потом 3 цыфри из ,infotile на дерево в инжекте1980 156 0 0 0 0
1987 156 0 0 0 0
1999 139 0 0 0 0
1999 84 0 0 0 0
UPDATE: о чудо, я переставил проверки перед бегином и добавил твою, оно начало ходить. не знаю с чем это связано . но теперь какие-то косяки с рубкой. остановилось на:
мб это мое последнее число? у меня оно постоянно 0, может я не правильно делаю, что беру его ,infotile'ом10:43:04 [redlight]: Идем в: 2000, 155
10:43:04 [redlight]: Счас в: 2000, 155
10:43:04 [redlight]: x=2000, y=155
10:43:04 [redlight]: проверка 4
10:43:04 [redlight]: TEST (5 of 9): пришел в координаты 2000,155
-
- Neophyte
- Posts: 30
- Joined: 10.04.2008 22:26
-
- Neophyte
- Posts: 30
- Joined: 10.04.2008 22:26
Code: Select all
sub MarkRail()
; ====================================================
; ВНИМАНИЕ! Это скрипт для инжекта, а не для стелса!!!
; ====================================================
; Скрипт разметки маршрута передвижения чара и копки/рубки
; Создает файл со строками вида:
; X Y TileType TileX TileY TileZ
; где: X, Y - координаты чара в узловой точке
; TileType - тип цели. То есть тип тайла или статики,
; которую либо рубим/либо копаем
; TileX, TileY, TileZ - координаты цели
; Узловые точки могут быть двух видов - либо тут копаем/рубим,
; либо тут чар должен повернуть при передвижении. Если второе, то
; последние четыре параметра равны 0. Учитывайте это в своих скриптах.
;
; Как работает? Записываются начальные координаты с нулями в четырех последних
; параметрах, запоминается направление взгляда чара, чистится журнал.
; Потом каждые 50 мс проверяются: не изменилось ли направление взгляда чара, не
; появилось ли сообщение в журнале о копке/рубке. Если одно из условий выполнено,
; то в файл записывается строка с текущими данными чара. То есть, если чар повернул,
; но копка/рубка не началась - пишется строка с четырьмя нулями в конце, если есть
; сообщение - пишутся координаты ласттайла и тип из-под него.
; Скрипт прекращает работу при появлении в журнале слова Finish, произнесенного
; данным чаром (проверяется по сериалу строки журнала).
;
; v.1.01b (с) Edred
;
; В данной версии данные пишутся в текстовое окно, а не файл.
; Также не проверяется сериал чара, сказавшего Finish.
;
VAR msg1 = 'You put the'
VAR msg2 = 'There is nothing'
VAR msgf = 'Finish'
VAR cx1, cy1, cdir1, tx1, ty1, tz1, ttyp1, oldx, oldy
UO.TextOpen()
UO.TextClear()
cx1 = UO.GetX()
cy1 = UO.GetY()
cdir1 = UO.GetDir()
UO.TextPrint(str(cx1) + ' ' + str(cy1) + ' ' + '0 0 0 0')
oldx = cx1
oldy = cy1
repeat
UO.DeleteJournal()
repeat
wait(50)
until UO.InJournal(msg1) OR UO.InJournal(msg2) OR UO.InJournal(msgf) OR UO.GetDir() <> cdir1
if UO.InJournal(msgf) then
return
endif
If UO.InJournal(msg1) OR UO.InJournal(msg2) Then
cx1 = UO.GetX()
cy1 = UO.GetY()
ttyp1 = UO.LastTile( 0 )
tx1 = UO.LastTile( 1 )
ty1 = UO.LastTile( 2 )
tz1 = UO.LastTile( 3 )
UO.TextPrint(str(cx1) + ' ' + str(cy1) + ' ' + str(ttyp1) + ' ' + str(tx1) + ' ' + str(ty1) + ' ' + str(tz1))
oldx = cx1
oldy = cy1
cdir1 = UO.GetDir()
Else
cx1 = UO.GetX()
cy1 = UO.GetY()
if (cx1 <> oldx) OR (cy1 <> oldy) then
UO.TextPrint(str(cx1) + ' ' + str(cy1) + ' ' + '0 0 0 0')
oldx = cx1
oldy = cy1
endif
cdir1 = UO.GetDir()
Endif
until false
endsub
-
- Neophyte
- Posts: 30
- Joined: 10.04.2008 22:26
почему-то не хочет идти резаться
стоит на месте убийства и пишет:
стоит на месте убийства и пишет:
UPD: исправил, это были косяки с моим дописанным хайдом[21:54:27] System: You can't do much in your current state.
[21:54:30] System: You can't do much in your current state.
[21:54:32] System: You can't do much in your current state.
Прикрутил новую ходилку к скрипту, почемуто не работает...Точнее работает, но както странно....Он рубит определённый вес, потом идёт до конца маршрута, а не к сундуку. Выгружается и идёт с первой точки маршрута...Подскажите плиз, что не так...
Это скрипт.
А это ходилка.
Code: Select all
program LambIsengard101;
// В папке D:\Games\Railes есть файл имя_чара.txt и файл res.txt
// Первый - это маршрут перемещения чара по лесу от сундука и обратно к
// сундуку. При килле чар идет дальше по маршруту вплоть до сундука.
// Второй файл - маршрут от сундука до креста для реса.
// Вырубленные логи скидывать в сундук. Топоры брать из мешка оттуда же.
// В общем, как в мининге.
//
// v.1.01 (c) Edred
{$Include 'all.inc'}
const
MyMaxWeight = 350;
Msg1 = 'You put the';
Msg2 = 'You hack';
Msg3 = 'You must';
Msg4 = 'bbb';
Msg5 = 'There are no';
Msg6 = 'Try chopping';
Msg7 = 'You can''t';
Hatchet1 = $0F43;
Hatchet2 = $0F44;
AnkhID = $40002DFE;
Sunduk = $405C0AA7;
BagHatchets = $4010F519;
DeadLife = 40;
Logs = $1BDD;
WoodType = $0F90;
type LumbRecord = Record
x,y,tt,tx,ty,tz : integer;
end;
var
LumberDim : array [0..5000] of LumbRecord;
ResDim : array [0..5000] of LumbRecord;
Regs : array [1..3] of Cardinal;
MaxPosL, MaxPosR, k : integer; // длины соответствующих массивов
CharRail, ResRail : String;
LumberFlag : Boolean; // true - работаем, false - нет (разгрузка или смерть)
ctime : TDateTime;
procedure GetLumberRail(s : String; WPos : Integer; flag : Boolean);
// flag - true - маршрут для ламбера, false - маршрут для реса
begin
s := s + ' ';
if flag then
begin
LumberDim[WPos].x := StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
LumberDim[WPos].y := StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
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));
LumberDim[WPos].tz := StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
end
else
begin
ResDim[WPos].x := StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
ResDim[WPos].y := StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
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));
ResDim[WPos].tz := 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;
procedure CheckDead;
begin
if Dead then exit;
if HP < 40 then
begin
Disconnect;
wait(5000);
Connect;
repeat
wait(100);
until Connected;
end;
end;
procedure RestoreStamina;
// если стамины мало, восстанавливаем ее чару до полной
begin
if Stam < 20 then
begin
repeat
waitconnection(3000);
wait(1000);
until Stam = MaxStam;
end;
end;
function CheckHatchet : Boolean;
// проверяем, есть ли топор у чара в паке или на нужном слое.
// если ее нет - открываем сундук и мешок, берем топор. Если топора нет
// в мешке - выход.
var tmpser : Cardinal;
begin
Result := true;
waitconnection(3000);
if (ObjAtLayerEx(RhandLayer,self) <> 0) or (count(Hatchet1)<>0) or (count(Hatchet2)<>0) then exit;
// нет у чара топора
repeat
UseObject(Sunduk);
wait(1000);
checksave;
UseObject(BagHatchets);
wait(1000);
checksave;
tmpser := findtype(Hatchet1,BagHatchets);
if tmpser = 0 then tmpser := findtype(Hatchet2,BagHatchets);
if tmpser <> 0 then
begin
Grab(tmpser,1);
wait(1000);
checksave;
end;
until (count(Hatchet1)<>0) or (count(Hatchet2)<>0);
end;
procedure ResChar;
// идем по маршруту на рес, ресаем чара, восстанавливаем здоровье, возвращаемся
// по тому же маршруту в обратную сторону
var
f : integer;
tmptime : TDateTime;
begin
AddToSystemJournal('TEST: нужен рес чара');
For f := 0 to MaxPosR-1 do
begin
repeat
GotoXY(ResDim[f].x,ResDim[f].y,true,0);
wait(300);
until (GetX(self)=ResDim[f].x) and (GetY(self)=ResDim[f].y);
end;
// чар у креста
AddToSystemJournal('TEST: чар у креста');
WaitConnection(5000);
if WarMode = true then SetWarMode(false);
repeat
UseObject(AnkhID);
wait(2000);
checksave;
until not Dead;
// лечим чара
AddToSystemJournal('TEST: лечим чара');
while (HP<MaxHP) do
begin
waitconnection(3000);
tmptime := Now;
f := 0
UseSkill('Spirit Speak');
repeat
wait(100);
f := f + 1;
until (InJournalBetweenTimes('You fail|You channel|You lack|You establish', tmptime, Now)<>-1) or (Mana < (MaxMana - 50)) or (n > 300);
wait(500);
if Mana < 30 then
begin
tmptime := Now;
f := 0;
repeat
waitconnection(3000);
useskill('meditation');
wait(2000);
f := f + 1;
checksave;
until (InJournalBetweenTimes('reached full mana', tmptime, Now)<>-1) or (n = 100);
end;
end;
// пойдем обратно
AddToSystemJournal('TEST: идем обратно к сундуку');
For f := 0 to MaxPosR-1 do
begin
repeat
GotoXY(ResDim[MaxPosR-1-f].x,ResDim[MaxPosR-1-f].y,true,0);
wait(300);
until (GetX(self)=ResDim[MaxPosR-1-f].x) and (GetY(self)=ResDim[MaxPosR-1-f].y);
end;
end;
procedure Discharge;
// разгружаем нарубленное в сундук
// нарубленное - реги в массиве Regs[1..3]
// логи - константа Logs
var m, tmpcnt : integer;
tmpid, tmpstack, tmpcolor : Cardinal;
tmpname : String;
begin
AddToSystemJournal('TEST: разгрузка');
waitconnection(3000);
CheckDead;
if Dead then exit;
UseObject(Sunduk);
wait(1000);
checksave;
// выложим реги
for m := 1 to 3 do
begin
tmpcnt := 0;
Repeat
tmpid := Findtype(Regs[m],backpack);
if tmpid = 0 then break;
addtosystemjournal( 'Отладка: найдено ' + inttostr(GetQuantity(tmpid)) + ' regs');
tmpcnt := tmpcnt + 1;
if tmpcnt > 10 then
begin
addtosystemjournal('Ошибка: не могу переместить regs!');
wait(15000);
end;
tmpstack := Findtype(Regs[m],Sunduk);
// Если не найден в банке - тогда просто в контейнер
if tmpstack = 0 then tmpstack := Sunduk;
MoveItem(tmpid,GetQuantity(tmpid),tmpstack,0,0,0);
wait(1000);
CheckSave;
until tmpid = 0;
end;
// выложим дид вуды
tmpcnt := 0;
Repeat
tmpid := Findtype(WoodType,backpack);
if tmpid = 0 then break;
addtosystemjournal( 'Отладка: найдено ' + inttostr(GetQuantity(tmpid)) + ' dead woods');
tmpcnt := tmpcnt + 1;
if tmpcnt > 10 then
begin
addtosystemjournal('Ошибка: не могу переместить dead woods!');
wait(15000);
end;
tmpstack := Findtype(WoodType,Sunduk);
// Если не найден в банке - тогда просто в контейнер
if tmpstack = 0 then tmpstack := Sunduk;
MoveItem(tmpid,GetQuantity(tmpid),tmpstack,0,0,0);
wait(1000);
CheckSave;
until tmpid = 0;
// выложим логи
tmpcnt := 0;
Repeat
tmpid := Findtype(Logs,backpack);
if tmpid = 0 then break;
tmpcolor := GetColor(tmpid);
tmpname := ' unknown logs';
case tmpcolor of
$0000 : tmpname := ' logs';
$037F : tmpname := ' Grave logs';
$0039 : tmpname := ' Willow logs';
$0026 : tmpname := ' Maple logs';
$0405 : tmpname := ' Oak logs';
$0994 : tmpname := ' Bloody logs';
$048A : tmpname := ' Nature logs';
$0898 : tmpname := ' Spirits logs';
end;
addtosystemjournal( 'Отладка: найдено ' + inttostr(GetQuantity(tmpid)) + tmpname);
tmpcnt := tmpcnt + 1;
if tmpcnt > 10 then
begin
addtosystemjournal('Ошибка: не могу переместить логи');
wait(15000);
end;
repeat
tmpstack := FindtypeEx(Logs,tmpcolor,Sunduk,False);
if GetQuantity(tmpstack) >= 65000 then Ignore(tmpstack);
until (tmpstack = 0) OR (GetQuantity(tmpstack) < 65000);
// Если не найден в сундуке - тогда просто в контейнер
if tmpstack = 0 then tmpstack := Sunduk;
MoveItem(tmpid,GetQuantity(tmpid),tmpstack,0,0,0);
wait(1000);
CheckSave;
until tmpid = 0;
IgnoreReset;
AddToSystemJournal('TEST: разгрузка закончена');
end;
function LumbCurTree(tile,x,y,z : Integer) : Boolean;
// рубим указанный тайл. Возвращаем false если перевес или чар мертв.
var q, m1, m2, m3, m4, m5, m6, m7, CountFizzle : integer;
begin
Result := true;
CountFizzle := 0;
repeat
if WarMode = true then SetWarMode(false);
if TargetPresent then CancelTarget;
ctime := Now;
if Dead then begin Result := false; exit; end;
if UseType(Hatchet1,$FFFF) = 0 then
begin
if UseType(Hatchet2,$FFFF) = 0 then
begin
Result := false;
exit;
end;
end;
WaitForTarget(5000);
If TargetPresent then TargetToTile(tile, x, y, z);
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);
m5 := InJournalBetweenTimes(Msg5, ctime, Now);
m6 := InJournalBetweenTimes(Msg6, ctime, Now);
m7 := InJournalBetweenTimes(Msg7, ctime, Now);
until (m1<>-1) or (m2<>-1) or (m3<>-1) or (m4<>-1) or (m5<>-1) or (m6<>-1) or Dead or (q > 300);
if (m2<>-1) or (m3<>-1) or (m4<>-1) then CountFizzle := CountFizzle + 1;
if Dead or (Weight > MyMaxWeight) then begin Result := false; exit; end;
until (m5<>-1) OR (m6<>-1) OR (m7<>-1) OR (CountFizzle = 100);
end;
Begin
Regs[1] := $0F85; // ginseng
Regs[2] := $0F88; // Nightshade
Regs[3] := $0F86; // Mandrake Roots
CharRail := 'D:\Games\Railes\' + GetName(self) + '.txt';
ResRail := 'D:\Games\Railes\res.txt';
GetRail(CharRail,true);
AddToSystemJournal('Маршрут ' + CharRail + ' загружен');
GetRail(ResRail,false);
AddToSystemJournal('Маршрут ' + ResRail + ' загружен');
// Стартуем от сундука
repeat
CheckDead;
if Dead then LumberFlag := false else LumberFlag := true;
if LumberFlag then
begin
if not CheckHatchet then exit;
For k := 0 to MaxPosL-1 do
begin
// идем по маршруту
repeat
RestoreStamina;
GotoXY(LumberDim[k].x,LumberDim[k].y,true,0);
wait(300);
until (GetX(self)=LumberDim[k].x) and (GetY(self)=LumberDim[k].y);
AddToSystemJournal('TEST (' + inttostr(k) + ' of ' + inttostr(MaxPosL-1) + '): пришел в координаты ' + inttostr(LumberDim[k].x) + ',' + inttostr(LumberDim[k].y));
if LumberFlag and (LumberDim[k].tt <> 0) then
// Будем рубить
LumberFlag := LumbCurTree(LumberDim[k].tt,LumberDim[k].tx,LumberDim[k].ty,LumberDim[k].tz);
end;
end;
// мы снова у сундука
if not Dead then Discharge else ResChar;
until False;
End.
Code: Select all
//////////////////////////////////////////////////////////////////////////////////////////////
// move_v0_2.inc 11.09.2008 //
// crafted by SevenAmber. e-mail: [email protected] //
// алгоритм прохода к указанной точке с обходом небольших препятствий //
/////////////////////////////////////////////////////////////////////////////////////////////
type
Dim8= Array[0..8] of integer;
T_Dir_XY=record
x:integer;
y:integer;
end;
var
Co_ord_X,Co_ord_Y: Array of integer;
Dir_Ch:array of string;
revDir:dim8;
IsInit:boolean;
Const
N=0;// North
NE=1;//NorthEast
E=2;//East
SE=3;//SouthEeast
S=4;//South
SW=5;//SouthWest
W=6;//West
NW=7;//NorthWest
SLF=8;//self
Procedure Init_GoXY; // инициализация
begin
Dir_Ch:=['N','NE','E','SE','S','SW','W','NW','SLF'];
Co_ord_X:=[0,1,1,1,0,-1,-1,-1,0];
Co_ord_Y:=[-1,-1,0,1,1,1,0,-1,0];
revDir[N]:=S;revDir[S]:=N;revDir[W]:=E; revDir[E]:=W;
revDir[NW]:=SE;revDir[SE]:=NW;revDir[NE]:=SW; revDir[SW]:=NE;
revDir[SLF]:=SLF;
IsInit:=true;
end;
function encode_dir(direction:integer):T_Dir_XY; // из направления получаем координаты
var
TempDir:T_Dir_XY;
begin
TempDir.X:=GetX(self)+Co_ord_X[direction];
TempDir.Y:=GetY(self)+Co_ord_Y[direction];
Result:=TempDir;
end;
function CrdToString(sx,sy:integer):string;// координаты в строку типа <X,Y>
begin
Result:='<'+IntToStr(sx)+','+IntToStr(sy)+'>'
end;
function DirToStr(direction:integer):string;// направление в строку типа <X,Y>
var
TempDir:T_Dir_XY;
begin
TempDir:= encode_dir(direction);
Result:=CrdToString(TempDir.X,TempDir.Y);
end;
function isCorrectDir(direction:integer;DirStr:string):boolean;// проверка правильности направления
// не пытался ли чар уже идти в данную точку
var
strDir:string;
begin
strDir:=DirToStr(direction);
if (Pos(strDir,DirStr)=0) then Result:=true else Result:=false;
end;
// персечение множества координат вокург себя с координатами в строке Pstr
function AroundSelf(Pstr:string):string;
var
i:integer;
rStr:string;
begin
rStr:='';
for i:=N to NW do
if (not isCorrectDir(i,Pstr)) then rStr:=DirToStr(i)+rStr;
Result:=rStr;
end;
function code_dir(fX,fY:integer):integer; // из координат назначения получаем направление
var
tx,ty,t,i:Longint;
begin
i:=0;
tx:=fX - GetX(self);
ty:=fY - GetY(self);
t:=Trunc(Abs(tx));
if tx<>0 then tx:=tx/t;
t:=Trunc(Abs(ty));
if ty<>0 then ty:=ty/t;
for i:=N to SLF do
if ((tx=Co_ord_X[i]) and(ty=Co_ord_Y[i])) then Result:=i;
end;
function detour(dir:integer;ClockWise:boolean):integer; // смена направления
// ClockWise = true - чар поворачивается по часовой стрелке
// ClockWise = false - чар поворачивается пhjnbd часовой стрелки
begin
if ClockWise then
if dir=7 then Result:=0 else Result:=dir+1
else
if dir=0 then Result:=7 else Result:=dir-1;
end;
function Move(Direction:integer):boolean;// Делает один шаг в указанном направлении
var
isNotStop, isMove:boolean;
mx,my:integer;
begin
mx:=GetX(self);
my:=GetY(self);
repeat
CheckSave;
isNotStop:=Raw_Move(Direction,false);
{ToDo- тут следует вставлять проверку на хайд}
if (((mx-GetX(self))<>0) or ((my-GetY(self))<>0)) then isMove:=true else isMove:=false;
if isMove then isNotStop:=false;
until not isNotStop;
Result:=isMove;
end;
procedure GotoXY(gX:integer;gY:integer;ClWi:boolean;acc:byte); // основная функция
// acc - точность подхода
// ClWi - используется в detour в качестве ClockWise
var
isGo:boolean;
TempDir:integer;
ReverseDir:integer;
DirStrNow,DirStrPre:string;
Begin
if not IsInit then Init_GoXY;
if ((Abs(GetX(self)-gX)<=acc) AND (Abs(GetY(self)-gY)<=acc)) then exit;
TempDir:= code_dir(gX,gY);
repeat
CheckSave;
if isCorrectDir(TempDir,DirStrNow) then isGo:=Move(TempDir) else isGo:=false;
if isGo then
begin
ReverseDir:= revDir[TempDir];
TempDir:= code_dir(gX,gY);
if ReverseDir=TempDir then TempDir:=detour(TempDir,ClWi);
DirStrPre:=DirStrNow;
DirStrNow:=AroundSelf(DirStrPre);
end
else
begin
DirStrNow:=DirStrNow+DirToStr(TempDir);
TempDir:= detour(TempDir,ClWi);
end;
until ((Abs(GetX(self)-gX)<=acc) AND (Abs(GetY(self)-gY)<=acc));
end;
Выбивает такую ошибку:
Хотя в файлы лежат в нужном месте
Code: Select all
1:09:50 [Slade]: Cannot open file "D:\Games\Railes\System.txt". Системе не удается найти указанный путь at 33.80
1:09:50 [Slade]: Script Начало.txt stoped successfuly
Code: Select all
D:\Games\Railеs
а что скажет вот это?
Code: Select all
if FileExists('D:\Games\Railes\System.txt') then
AddToSystemJournal('File is found...')
else
AddToSystemJournal('File not found!!!');
"Как хочешь ты трудись;
Но приобресть не льстись
Ни благодарности, ни славы,
Коль нет в твоих трудах ни пользы, ни забавы. (с) С.Крылов."
Но приобресть не льстись
Ни благодарности, ни славы,
Коль нет в твоих трудах ни пользы, ни забавы. (с) С.Крылов."