Форум работает в тестовом режиме. Все данные были перенесены со старого сайта 2018 года. Некоторая информация может быть недоступна, например вложения или хайды. Просьба сообщать о данных случаях через функционал "Жалоба", прямо под постом, где отсуствуют данные из хайда или проблемы с вложением.
Могут быть проблемы в "выкидыванием" с форума (слетевшей авторизацией). Нужно собрать статистику таких случаев.
Есть Тема, куда можете сообщить о проблемах с сайтом либо просто передать привет.

Объединение скриптов.

N

Nevada

Рег
20 Ноя 2015
Сообщения
94
Реакции
0
Всем привет!
Возникла проблема с объединением скриптов.
Есть процедура создания нового списка


type
TL2CharListItem = packed record
Ch: TL2Char;
Rating: integer;
end;
TL2CharList = packed record
Items: array [0..1500] of TL2CharListItem;
Count: integer;
end;

var
i,j,n: integer;
Chars: TL2CharList;
Sorted: boolean;
Tmp: TL2CharListItem;
const
ClassPriorityList: array of integer = [
88, 4,
91, 4,
111,4,
94 ,3
];


procedure SortChars;
begin
end;
begin
while engine.status=lsonline do
begin
Chars.Count:= 0;
for i:= 0 to CharList.count - 1 do
begin
inc(Chars.Count);
Chars.Items.Ch:= CharList.items(i);
Chars.Items.Rating:= 0;
for j:= 0 to high(ClassPriorityList) do
begin
if (Chars.Items.Ch.ClassID = ClassPriorityList[j]) then
begin
Chars.Items.Rating:= ClassPriorityList[j+1];
break;
end;
inc(j);
end;
end;

// Сортируем
SortChars;
begin
n:= Chars.Count;
repeat
Sorted:= false;
Dec(n);
if n > 0 then
for i:= 0 to n - 1 do
if (Chars.Items.Rating < Chars.Items[i+1].Rating) then
begin
Tmp:= Chars.items;
Chars.items:= Chars.items[i + 1];
Chars.items[i + 1]:= Tmp;
Sorted:= true;
end;
until not Sorted;
end;


for i:=0 to Chars.Count -1 do
If Chars.Items.Rating>0 then
print(chars.items.ch.name);
delay(20000);
end;
end.

И допустим, есть процедура

procedure APContoller;
var
buff: TL2Buff;
begin
while Engine.Status = lsOnline do
begin
if not User.Dead and not User.Buffs.ById(337, buff) then
Engine.UseSkill(337);
delay(1000);
end;
end;

При попытке объединения данных скриптов через

begin
script.newthread(@Sortchars);
script.newthread(@APContoller);
end.

Работает только скрипт на создание нового списка.

При удалении

procedure SortChars;
begin //удаляем
end; //удаляем
begin
while engine.status=lsonline do
begin
Chars.Count:= 0;
for i:= 0 to CharList.count - 1 do

Скрипт ругается на строку (Stack Overflow)

// Сортируем
SortChars; // ругается
begin
n:= Chars.Count;

При ее удалении, список не сортируется, но работают 2 процедуры.

Вопрос. Как объединить эти 2 скрипта? Заранее спасибо за ответы.
 
procedure SortChars;
begin
end;

вообще нездоровая конструкция. Получается, процедура SortChars пуста
А вообще - проверяй количество открывающих/закрывающих begin+end'ов.
В коде просто каша из них, даже главное тело программы выделить не получается.
 
// Сортируем
SortChars; // ругается
begin
n:= Chars.Count;
Ругается на строку (Stack Overflow). Что с этим можно сделатаь?
 
@Nevada,

type
TL2CharListItem = packed record
Ch: TL2Char;
Rating: integer;
end;
TL2CharList = packed record
Items: array [0..1500] of TL2CharListItem;
Count: integer;
end;

var
i,j,n: integer;
Chars: TL2CharList;
Sorted: boolean;
Tmp: TL2CharListItem;
const
ClassPriorityList: array of integer = [
88, 4,
91, 4,
111,4,
94 ,3
];


// [SortChars] НАЧАЛО ОПИСАНИЯ ПРОЦЕДУРЫ //
procedure SortChars;
begin
while engine.status=lsonline do
begin
Chars.Count:= 0;
for i:= 0 to CharList.count - 1 do
begin
inc(Chars.Count);
Chars.Items.Ch:= CharList.items(i);
Chars.Items.Rating:= 0;
for j:= 0 to high(ClassPriorityList) do
begin
if (Chars.Items.Ch.ClassID = ClassPriorityList[j]) then
begin
Chars.Items.Rating:= ClassPriorityList[j+1];
break;
end;
inc(j);
end;
end;
end;
end;
// [SortChars] КОНЕЦ ОПИСАНИЯ ПРОЦЕДУРЫ //


// Где начинается главное тело скрипта?
// Дальше идет вызов SortChars, это и есть начало самого скрипта?

SortChars;
begin
n:= Chars.Count;
repeat
Sorted:= false;
Dec(n);
if n > 0 then
for i:= 0 to n - 1 do
if (Chars.Items.Rating < Chars.Items[i+1].Rating) then
begin
Tmp:= Chars.items;
Chars.items:= Chars.items[i + 1];
Chars.items[i + 1]:= Tmp;
Sorted:= true;
end;
until not Sorted;
end;


for i:=0 to Chars.Count -1 do
If Chars.Items.Rating>0 then
print(chars.items.ch.name);
delay(20000);
end;
end.



Nevada написал(а):
Ругается на строку (Stack Overflow). Что с этим можно сделатаь?
Нажмите для раскрытия...
Я вообще не пойму как адреналин от такого кода не вываливает исключение в истерике и приступах эпиллепсии :pandaredlol:
нужно привести код в порядок, а потом смотреть что да как. У тебя идет обращение к процедуре в самой процедуре, а-ля рекурсия. Не думаю что так было задумано
 
@Krickt, я лишь скопировал то,что было в этой теме выше :hz: :pandaredlol:
 
uses sysutils,classes;


type
TL2CharListItem = packed record
Ch: TL2Char;
Rating: integer;
end;
TL2CharList = packed record
Items: array [0..1500] of TL2CharListItem;
Count: integer;
end;


var
i,j: integer;
Chars: TL2CharList;

const
ClassPriorityList: array of integer = [
// ID класса, приоритет
88, 4,
91, 4,
111,4,
94 ,3
];




procedure SortChars23;
begin while true do
delay(20);
begin
// формируем свой список группы с дополнительным полем Rating
Chars.Count:= 0;
for i:= 0 to CharList.count - 1 do
begin
inc(Chars.Count);
Chars.Items.Ch:= CharList.items(i);
Chars.Items.Rating:= 0;
// находим класс в списке классов и выставляем Rating по приоритету класса
for j:= 0 to high(ClassPriorityList) do
begin
if (Chars.Items.Ch.ClassID = ClassPriorityList[j]) then
begin
Chars.Items.Rating:= ClassPriorityList[j+1];
break;
end;
inc(j); // увеличиваем дополнительно, чтобы по i был ID класса
end;
end;


// Сортируем
SortChars;


// Все, теперь наша пати отсортирована по классам, можем использовать
for i:=0 to Chars.Count -1 do
print(chars.items.ch.name);
end;
end;


procedure SortChars;
var
Sorted: boolean;
i, n: integer;
Tmp: TL2CharListItem;
begin
while true do
delay(20);
begin
n:= Chars.Count; // кол-во игроков
repeat
Sorted:= false;
Dec(n);
if n > 0 then
for i:= 0 to n - 1 do
if (Chars.Items.Rating > Chars.Items[i+1].Rating) then // сравниваем рейтинг
begin
Tmp:= Chars.items; // запоминаем 1 ячейку (нужен такой же тип, что и у элементов нашей структуры)
Chars.items:= Chars.items[i + 1]; // в 1 ячейку суем 2ую
Chars.items[i + 1]:= Tmp; // во 2 ячейку суем сохраненную 1ую
Sorted:= true; // обмен успешен
end;
until not Sorted; // пока обмен успешен
end;
end;




begin
script.newthread(@sortchars23);
script.newthread(@sortchars);
end.



@SARCAZM, @Krickt, Что-то типа такого должно быть?
 
Это пиздец. Даже не хочу ничего говорить.

Понакопируют в тупую, не понимая, что и как работает. И разбираться сами не хотят. Все им разжуй, в рот положи. Не хочу таким помогать.
 
procedure SortChars;
var
Sorted: boolean;
i, n: integer;
Tmp: TL2CharListItem;
begin
n:= Chars.Count; // кол-во игроков
repeat
Sorted:= false;
Dec(n);
if n > 0 then
for i:= 0 to n - 1 do
if (Chars.Items.Rating < Chars.Items[i+1].Rating) then // сравниваем рейтинг
begin
Tmp:= Chars.items; // запоминаем 1 ячейку (нужен такой же тип, что и у элементов нашей структуры)
Chars.items:= Chars.items[i + 1]; // в 1 ячейку суем 2ую
Chars.items[i + 1]:= Tmp; // во 2 ячейку суем сохраненную 1ую
Sorted:= true; // обмен успешен
end;
until not Sorted; // пока обмен успешен
end;
begin
// формируем свой список группы с дополнительным полем Rating
Chars.Count:= 0;
for i:= 0 to CharList.count - 1 do
begin
inc(Chars.Count);
Chars.Items.Ch:= CharList.items(i);
Chars.Items.Rating:= 0;
// находим класс в списке классов и выставляем Rating по приоритету класса
for j:= 0 to high(ClassPriorityList) do
begin
if (Chars.Items.Ch.ClassID = ClassPriorityList[j]) then
begin
Chars.Items.Rating:= ClassPriorityList[j+1];
break;
end;
inc(j); // увеличиваем дополнительно, чтобы по i был ID класса
end;
end;
// Сортируем
SortChars;
// Все, теперь наша пати отсортирована по классам, можем использовать
for i:=0 to Chars.Count -1 do
If Chars.Items.Rating>0 then
print(chars.items.ch.name);
delay(5000);
end .

@Krickt, штука работает. а как еще параллельно запустить другие потоки?
 
Добавлю к первому посут stack overflow это переполнения стека процедур , навиду пример для джавы а не делфи , в машине джавы есть стек его стандартный размер 16кбайт Это свое обрызный буфер . Есть у нас допустим процедура Х и процедура У . в реализации процедуры Х заложен вызов процедуры У . Теперь разберемся что такое стек. Стек это последовательное выполнение процедур в солбец где выполнение начинается с первой строки тобишь с первого елемента
Stack_Prologistic_com_ua.png,
возвращаемся к нашим процедурак Х и У.
Когда мы вызываем процедуру Х то она помещается в стек, Но в процедуре вызывается процедура У
В стеке получается

У
Х

Но в реализации У заложено вызов процедури Х Это уже называется рекурсия когда метод , процедура вызывает сама себя .и наш стек вылядит так


Х
У
Х
У
Х
У
Х
У
Х
У
Х
.
.
.
У
Х
И так до тех пор пока все 16 кбайт не заполнятся.

И после вылетает исключене что стек переполнин. Какой размер сетка в адрике мне не известно , и знать то сильно незачем.
И так для тех кто не знает , новый поток ето есть ни что иное как новый стек. У которого свой цикл независимый от основной программы.
Могу еще добавить что при наличии одного ядра на компютере новый поток как ни что иное как разделение процесорного времени на кванты , и каждому потоку дается свой промежуток для выполнения куска кода из стека .
Р.С . Просто не спалю вторые сутки , припаяло меня чутка.
 
Да и не визде напишут вообще что такое стек , и как оно выглядит.
 
Войдите или зарегистрируйтесь для ответа.
Назад
Сверху