Случайны выбор дневника Раскрыть/свернуть полный список возможностей


Найдено 1398 сообщений
Cообщения с меткой

delphi - Самое интересное в блогах

Следующие 30  »
rss_rss_hh_new

Автоматизированная генерация схемных компонентов из PDF файлов для Altium Designer

Суббота, 30 Апреля 2017 г. 00:18 (ссылка)



Несмотря на то, что Altium Designer поставляется с огромными библиотеками компонентов по-прежнему остается необходимость создания в нем своих схемных компонентов. Особенно это актуально для крупных микросхем с большим количеством выводов и атрибутов выводов. Это могут быть FPGA, микроконтроллеры, процессоры, чипы памяти и т.д. Здесь я представлю свою технологию генерации схемных компонентов экстрагируя информацию из PDF файлов.





Возьмем для примера даташиты на микроконтроллеры Kinetis, скажем серию K66. Нет труда извлечь схемные компоненты этих микроконтроллеров из многочисленных референс-дизайнов предоставляемых фирмой производителем. К счастью многие из них представлены в формате Altium Designer. Скачиваем отсюда архив «Hexiwear-Design-Files», находим там схему, а в ней вот такое представление компонента:



(Кликнуть для увеличения)




Здесь схемный компонент микроконтроллера разбит на несколько логических частей, так как было удобно автору схемы. Остается только завидовать профессионализму автора, но обычно такое скупое представление компонента затрудняет понимание работы схемы, а в последствии и поиск ошибок.

Микроконтроллер на своих выводах может поддерживать до 7-и альтернативных функций. Ошибись схемотехник в назначении функции хотя бы одного вывода и плату придется мучительно тюнинговать вручную после изготовления или даже выкинуть, если корпус — BGA.

Поэтому такой компонент мы не можем позаимствовать. Он к тому же представлен только для одного корпуса, а корпуса могут быть и другие, с другой распиновкой.

Не лучше обстоят дела и у компонентов микроконтроллеров, найденных в сторонних библиотеках. В них также не указываются альтернативные функции.



Я нашел выход в автоматизации генерации компонентов из pdf даташитов.

Шаг 1.

Определяем какими таблицами в даташите представлена распиновка. Для K66 она представлена в виде такой таблицы простирающейся на несколько листов.



(Кликнуть для увеличения)




Это удобное представление. В этой таблице сразу сведены и номера выводов и названия всех их функций. Но скажем, для микроконтроллеров STM32 ситуация будет сложнее, там есть отдельно таблица соответствия номеров выводов их базовым названиям и таблица соответствия базовых названий и всех альтернативных функций. Это тоже несложно решаемо.



Шаг 2.

Из PDF файла переносим таблицы в MS Excel. Я использовал для этого программу Adobe Acrobat. У нее существует бесплатная триальная версия.

Получаем таблице в Excel такого вида:



(Кликнуть для увеличения)




Шаг 3.

Экспортирую таблицу из Excel в текстовый файл где поля таблицы разделены символом табуляции (0x09).

Шаг 4.

Полученный нами файл таблицы наполнен всяческим мусором, унаследованным от форматирования в PDF файле. Это и ненужные переносы строк, и пробелы, и другие ненужные символы.

Поэтому я написал программу в Delphi которая импортирует файл и фильтрует мусор.



(Кликнуть для увеличения)




В окне программы указывается путь к файлу альтернативных функций портов (это экспортированная из Excel наша таблица), указывается тип корпуса микросхемы (список заполнен в программе на Delphi вручную), указывается директория и файл куда будет сконвертирована таблица в формат пригодный для последующего импорта в Altium (это должен быть файл с расширением .csv). Сепаратором для csv файла должна быть запятая. А разделяющий функции символ может быть произвольный, такой чтобы удобно читались перечисления функций в описании вывода.

Все правильно настроив нажимаем «Выполнить».

После успешного выполнения увидим в закладке «Выходная таблица для Altium» таблицу, предназначенную для обработки скриптом Altium Designer. Таблица сохранена в указанном ранее csv файле.



(Кликнуть для увеличения)




Шаг 5.

Открываем Altium Designer. Открываем библиотеку схемных компонентов где хотим создать новый компонент. Щелкаем последовательность DXP -> Run Script. Указываем путь к скрипту ImportPins.PRJSCR. Появляется такое окно:



(Кликнуть для увеличения)




В нем щелкаем RunImportPins. В появившемся диалоге указываем путь к нашему csv файлу и щелкаем Update Mapping. Получаем окно со следующим содержанием.



Щелкаем Execute и в окне редактора схемного компонента получаем изображение всех выводов с присвоенными им названиями и номерами:



(Кликнуть для увеличения)




Все! Работа сделана.



Может показаться, что это немного не то, что ожидалось от обещанной автоматизации. Но на самом деле точное соответствие номеров и названий выводов это самая ответственная и тяжелая работа при разработке схемных компонентов.

Далее можно вполне быстро отредактировать длину выводов, расположить их по полю, нарисовать контуры, разделить на функциональные группы и т.д. Это рутинная легкая работа, которая не приведет к фатальным ошибкам. Далее в редакторе футпринтов также без проблем сделать корпус микросхемы используя имеющиеся визарды. Поскольку корпуса у микроконтроллеров достаточно типовые.



Репозиторий проекта находится здесь.

В директории Pin_builder_MK66 находятся все файлы для повторения шагов и их результаты, описанные в этой статье. Там же исходные файлы конвертера на Delphi. В директории Import_pins_Altium_script находится проект скрипта для Altium Designer.

В файле FunctionsMapping.xlsx содержится исходная таблица, экспортированная из даташита.

csv файл для конвертации называется MK66FN2M0VLQ18.csv

Original source: habrahabr.ru (comments, light).

https://habrahabr.ru/post/327628/

Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
rss_rss_hh_new

Перегрузка операторов в freepascal на примере обыкновенных дробей

Среда, 26 Апреля 2017 г. 18:01 (ссылка)

image

Все мы помним, как в школе учили обыкновенные дроби. Числители, знаменатели, НОД и НОК, арифметические действия с дробями. Но и в реальной жизни обыкновенные дроби успешно применяются в разных сферах деятельности, в том числе юридической: например, в обыкновенных дробях могут выражаться доли участников хозяйственных обществ, доли в праве общей долевой собственности и т.д.

И вот, понадобилось как-то раз реализовать пару функций в корпоративном приложении для оперирования обыкновенными дробями. Современная реализация паскаля, будь то delphi или freepascal, предлагает удобные средства для этого.



Получившийся в итоге модуль вырос в процессе изучения перегрузки операторов.

Когда модуль уже был готов, я увидел, что год назад участники англоязычного форума freepascal разработали аналогичный, правда, коллективно утяжелили его массой функций и различных реализаций одного и того же. Ну, будем считать сделанное своеобразным импортозамещением.


Основным типом данных будет следующая структура:

 TFraction = record
Numerator: longint;
Denumerator: longint;
function Create(ANum, ADenum: longint): TFraction;
function toStr: string;
function toFloat: extended;
end;


Не забываем включать нужную директиву компилятора — {$MODESWITCH ADVANCEDRECORDS}




Структура имеет два поля — целочисленные числитель и знаменатель, функцию-конструктор для присвоения значения одной строкой и пару функций конвертации обыкновенной дроби в строку и десятичную дробь.

Вспомогательные функции модуля (могут использоваться и самостоятельно):

// приведение к общему знаменателю
procedure SetEqualDenum(var ALeftFr, ARightFr: TFraction);
// расширение дроби - умножение на целое число
function ExpandFraction(AFraction: TFraction; Factor: longint): TFraction;
// наибольший общий делитель
function gcd(ALeftDenum, ARightDenum: longint): longint;
// наименьшее общее кратное
function lcm(ALeftDenum, ARightDenum: longint): longint;
// сокращение дроби - делением на целое число, константа toGCD по умолчанию подразумевает приведение дроби к несократимой
function CollapseFraction(AFraction: TFraction; Divider: longint = toGCD): TFraction;
// функция сравнения двух дробей
function CompareFractions(ALeftFr, ARightFr: TFraction): TfrCompareResult;
// возвращает обратную дробь, то есть меняет местами числитель и знаменатель
function ReverseFraction(AFraction: TFraction): TFraction;


Главные же в модуле — перегруженные операторы для сложения, вычитания, умножения, деления, присваивания и сравнения дробей:

// сложение двух дробей
operator +(ALeftFr, ARightFr: TFraction) r: TFraction;
// сложение с целым числом
operator +(ALeftFr: TFraction; const Term: longint) r: TFraction;
// вычитание дробей
operator -(ALeftFr, ARightFr: TFraction) r: TFraction;
// вычитание целого числа
operator -(ALeftFr: TFraction; const Sub: longint) r: TFraction;
// умножение двух дробей
operator * (ALeftFr, ARightFr: TFraction) r: TFraction;
// умножение на целое число
operator * (AFraction: TFraction; const Multiplier: longint) r: TFraction;
operator * (const Multiplier: longint; AFraction: TFraction) r: TFraction;
// деление двух дробей
operator / (ALeftFr, ARightFr: TFraction) r: TFraction;
// деление на целое число
operator / (AFraction: TFraction; const Divider: longint) r: TFraction;
// проверяет на равеноство
operator = (ALeftFr, ARightFr: TFraction) r: boolean;
// проверяет, больше ли левая дробь
operator > (ALeftFr, ARightFr: TFraction) r: boolean;
// проверяет, меньше ли левая дробь
operator < (ALeftFr, ARightFr: TFraction) r: boolean;
// преобразование дроби из целого числа (знаменатель = 1)
operator := (const AIntegerPart: longint) r: TFraction;
// преобразование строки вида Ч/З в дробь
operator := (const AStringFr: string) r: TFraction;


К сожалению, в freepascal невозможно передать в качестве присваемого значения перечисление целых чисел (словарь, множество, называйте как угодно, смысл в том, что так нельзя: А := (1,2); или так B := [1,2]), поэтому инициирование дроби идет через функцию-конструктор или строковое значение, хотя ничто не мешает просто задать значения двум полям, но я хотел сделать как можно проще.


Реализация перегруженных методов, например, сложения, деления, присваивания или сравнения выглядит так:
operator+(ALeftFr, ARightFr: TFraction)r: TFraction;
begin
SetEqualDenum(ALeftFr, ARightFr);
r.Numerator := ALeftFr.Numerator + ARightFr.Numerator;
r.Denumerator := ALeftFr.Denumerator;
r := CollapseFraction(r, toGCD);
end;
...
operator/(ALeftFr, ARightFr: TFraction)r: TFraction;
begin
r := ALeftFr * ReverseFraction(ARightFr);
end;
...
operator:=(const AStringFr: string)r: TFraction;
var
i: integer;
begin
i := PosEx(char(SolidorSym), AStringFr);
if not TryStrToInt(LeftStr(AStringFr, i - 1), r.Numerator) then
raise Exception.Create('Numerator is not integer!');
if not TryStrToInt(RightStr(AStringFr, Length(AStringFr) - i), r.Denumerator) then
raise Exception.Create('Denumerator is not integer!');
end;
...
operator=(ALeftFr, ARightFr: TFraction)r: boolean;
begin
Result := CompareFractions(ALeftFr, ARightFr) = crEqual;
end;

operator>(ALeftFr, ARightFr: TFraction)r: boolean;
begin
Result := CompareFractions(ALeftFr, ARightFr) = crLeft;
end;

operator<(ALeftFr, ARightFr: TFraction)r: boolean;
begin
Result := CompareFractions(ALeftFr, ARightFr) = crRight;
end;




Повторюсь, в модуле “конкурентов” больше функций и перегруженных операторов, так они дополнительно перегрузили >=, <=, **, а также ввели присваивание через десятичную дробь и преобразование в строку с выдачей “правильной” дроби, последнее для математических выражений совершенно не нужно.

Для вычисления НОД я выбрал самый простой рекурсивный алгоритм:

function gcd(ALeftDenum, ARightDenum: longint): longint;
begin
if ARightDenum = 0 then
Result := abs(ALeftDenum)
else
Result := abs(gcd(ARightDenum, ALeftDenum mod ARightDenum));
end;


НОД нам нужен для сокращения дробей и вычисления НОК:

function lcm(ALeftDenum, ARightDenum: longint): longint;
begin
Result := abs(ALeftDenum * ARightDenum) div gcd(ALeftDenum, ARightDenum);
end;


НОК в свою очередь используем для приведения дробей к общему знаменателю:

procedure SetEqualDenum(var ALeftFr, ARightFr: TFraction);
var
tDenum: longint;
begin
if ALeftFr.Denumerator = ARightFr.Denumerator then
exit;
tDenum := lcm(ALeftFr.Denumerator, ARightFr.Denumerator);
ALeftFr := ExpandFraction(ALeftFr, tDenum div ALeftFr.Denumerator);
ARightFr := ExpandFraction(ARightFr, tDenum div ARightFr.Denumerator);
end;


А уж эта функция и используется в итоге в перегруженных операторах сложения, вычитания и сравнения.

Перегрузка операторов позволяет писать такие простые присваивания:

Fr1, Fr2: TFraction;
...
Fr1 := 12; // (получится дробь 12/1)
Fr2 := ‘3/5’; // (преобразование строки в дробь)
// ну или при необходимости
Fr3 := TFraction.Create(22,7); // 22/7


Становится проще записывать операции с дробями и неравенства:

Fr3 := Fr1+ Fr2;
Fr3 := Fr1 * Fr2;
Fr2 := Fr1 - 1;
Fr2 := Fr1 / 3;
Fr3 := Fr1 / Fr2;
if Fr1 > Fr2 …


Сработают и комбинированные операторы присваивания:

Fr1 += Fr2;
Fr2 -= 1;
Fr3 *= ‘1/2’;


Допустимы даже такие выражения:

if Fr1 > ‘2/3’ ...
while Fr2 < 1 ...


Эти неравенства отлично скомпилируются и дадут верный логический результат.

В стандартной поставке freepascal есть пара аналогичных модулей для работы с математическими матрицами и комплексными числами, можно посмотреть на их реализацию в качестве примеров.

По моему мнению, перегрузка операторов приносит такое же упрощение в чистоте и наглядности кода, как дженерики (особенно любимы мною списки из fgl), конечно, если вы не перегружаете оператор плюс методом деления. Компилятор всегда (ну почти) вас остановит, если вы забудете, что оператор перегружен или наоборот (из-за несоответствия типов данных).

Описанный модуль далек от совершенства, нужно еще добавить обработку результата в случаях получения нуля при математических операциях, деления на ноль, также можно добавить преобразования десятичных дробей в обыкновенные и наоборот.



Полный текст модуля приведен здесь.

Модуль с форума freepascal.org.
Original source: habrahabr.ru (comments, light).

https://habrahabr.ru/post/327450/

Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
nozexglusiveyy24

Без заголовка

Воскресенье, 23 Апреля 2017 г. 21:48 (ссылка)

Delphi ds150e в Новосибирске - https://vk.com/page-132448884_52888203

Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
prafessiynaldy

Без заголовка

Пятница, 15 Апреля 2017 г. 03:51 (ссылка)

Delphi DS 1050E в Волгограде - https://vk.com/page-129469175_54621518

Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
nashtelfuu6

Без заголовка

Пятница, 14 Апреля 2017 г. 20:57 (ссылка)

Delphi DS 1050E в Волгограде - https://vk.com/page-129469175_54621518

Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
rss_rss_hh_new

JNI и Delphi. Портирование кода с C++ на Delphi

Среда, 12 Апреля 2017 г. 19:53 (ссылка)

Всем доброго времени суток! Сегодня мы разберем небольшой пример портирования кода с С++ на Delphi. Раз мы занялись JNI, то попутно все равно придется в дальнейшем учиться портировать код С++ на Delphi. И так давайте же перейдем уже к примеру. Мы будем портировать некую Процедуру с С++ на Delphi. Вот как выглядит эта Процедура на С++:

JNIEXPORT void JNICALL Java_JavaHowTo_sayHello
(JNIEnv *env, jobject obj) {
const char *str;
jclass myclass_class =(jclass) env->NewGlobalRef
(env->FindClass ("MyClass"));
// we need the MyClass constructor
jmethodID constructorID = env->GetMethodID
(myclass_class, "", "()V");
// and the sayHello() method
jmethodID methodID = env->GetMethodID
(myclass_class, "sayHello", "()Ljava/lang/String;");
// instanciate a MyClass object
jobject myclass_object = env->NewObject
(myclass_class, constructorID);
// call the sayHello() method
jstring s = (jstring) env->CallObjectMethod
(myclass_object, methodID);
// convert the Java String to use it in C
str = env->GetStringUTFChars(s, 0);
printf("%s" , str);
env->ReleaseStringUTFChars(s, str);
}
А так код будет выглядеть на Delphi:
procedure Java_JavaHowTo_sayHello(JNIEnv: PJNIEnv; Obj: JObject);
var
myclass_class: JClass;
constructorID, methodID: JMethodID;
myclass_object: JObject;
s: JString;
Str: PAnsiChar;
begin
myclass_class:= JNIenv^.NewGlobalRef(JNienv, JNIEnv^.FindClass(JNIEnv, 'MyClass'));
// we need the MyClass constructor
constructorID:= JNIEnv^.GetMethodID(JNIEnv, myclass_class, '', '()V');
// and the sayHello() method
methodID:= JNIEnv^.GetMethodID(JNIEnv, myclass_class, 'sayHello', '()Ljava/lang/String;');
// instanciate a MyClass object
myclass_object:= JNIEnv^.NewObject(JNIEnv, myclass_class, constructorID);
// call the sayHello() method
s:= JNIEnv^.CallObjectMethod(JNIEnv, myclass_object, methodID);
// convert the Java String to use it in C
str:= JNIEnv^.GetStringUTFChars(JNIEnv, s, 0);
JNIEnv^.ReleaseStringUTFChars(JNIEnv, s, str);
end;
И так как вы уже заметили я убрал некоторый мусор который нам не нужен «printf(»%s", str);" и указал «Str» не Константой, а просто объявил как PAnsiChar т.е. всегда есть некие модернизации кода и от них никуда не деться =)
Original source: habrahabr.ru (comments, light).

https://habrahabr.ru/post/326364/

Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
Bloom_Princces

Без заголовка. Обсуждение на

Пятница, 07 Апреля 2017 г. 10:44 (ссылка)

Это цитата сообщения Майя_Пешкова Оригинальное сообщение


Рождественские обычаи и традиции Великобритании

 





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





 

На Рождество все окна сельских домов освещены в Великобритании свечами, поэтому среди местных жителей ночь под Рождество называется "ночь свечей". В Англии в наши дни в сочельник вместо традиционного Рождественского бревна зажигают толстую Рождественскую свечу.



далее
Комментарии (0)КомментироватьВ цитатник или сообщество
rss_rss_hh_new

Использование code blocks из Objective-C в Delphi на macOS: как мы навели мосты

Четверг, 30 Марта 2017 г. 14:30 (ссылка)

image



Многие, наверное, слышали о замечательном способе решения программистских задач под названием метод утенка (rubber duck debugging). Суть метода в том, что надо сесть в ванную, расслабиться, посадить на воду игрушечного утенка, и объяснить ему суть той проблемы, решение которой вы не можете найти. И, чудесным образом, после такой беседы решение находится.



В своей прошлой статье на Хабре, где я рассказывал о разработке TamoGraph Site Survey для macOS, в роли утенка оказался сам Хабр: я пожаловался на то, что нам никак не удается придумать способ реализации code blocks из Objective-C в Delphi. И это помогло! Пришло просветление, и всё получилось. О ходе мыслей и о конечном результате я и хочу рассказать.



Итак, для тех кто не читал прошлую статью, еще раз кратко излагаю суть проблемы. Code blocks — это языковая фича С++ и Objective-C, которая не поддерживается в Delphi. Точнее, Delphi имеет свой аналог code blocks, но он несовместим с теми code blocks, которые ожидает от наc macOS API. Дело в том, что многие классы имеют функции, в которых используются code blocks в качестве handler'ов завершения. Самый простой пример — beginWithCompletionHandler классов NSSavePanel и NSOpenPanel. Передаваемый сode block выполняется в момент закрытия диалога:



- (IBAction)openExistingDocument:(id)sender {
NSOpenPanel* panel = [NSOpenPanel openPanel];

// This method displays the panel and returns immediately.
// The completion handler is called when the user selects an
// item or cancels the panel.
[panel beginWithCompletionHandler:^(NSInteger result){
if (result == NSFileHandlingPanelOKButton) {
NSURL* theDoc = [[panel URLs] objectAtIndex:0];

// Open the document.
}

}];
}


Побеседовав с утенком, я осознал, что не с того конца подходил к решению проблемы. Наверняка эта проблема существует не только в Delphi. Следовательно, надо начать с того, как решается проблема в других языках. Google в руки и мы находим очень близкий к нашей теме код для Python и JavaScript тут и тут. Хороший старт: если им это удалось, то удастся и нам. По сути, нам нужно всего лишь создать структуру в правильном формате, заполнить поля, и указатель на такую структуру и будет тем самым магическим указателем, который мы сможем передавать в те методы классов macOS, которые ожидают от нас блоков. Еще немного гугления, и мы находим хедер на сайте Apple:



struct Block_descriptor {
unsigned long int reserved;
unsigned long int size;
void (*copy)(void *dst, void *src);
void (*dispose)(void *);
};

struct Block_layout {
void *isa;
int flags;
int reserved;
void (*invoke)(void *, ...);
struct Block_descriptor *descriptor;
// imported variables
};


Излагаем это на Паскале:



  Block_Descriptor = packed record
Reserved: NativeUint;
Size: NativeUint;
copy_helper: pointer;
dispose_helper: pointer;
end;
PBlock_Descriptor = ^Block_Descriptor;

Block_Literal = packed record
Isa: pointer;
Flags: integer;
Reserved: integer;
Invoke: pointer;
Descriptor: PBlock_Descriptor;
end;
PBlock_Literal = ^Block_Literal;


Теперь, почитав еще немного о блоках (How blocks are implemented и на Хабре, Objective-C: как работают блоки), перейдем к созданию блока, пока в самом простом варианте, на коленке:



Var
OurBlock: Block_Literal;
function CreateBlock: pointer;
var
aDesc: PBlock_Descriptor;
begin
FillChar(OurBlock, SizeOf(Block_Literal), 0);
// Isa – первое поле нашего блока-объекта, и мы пишем в него
// указатель на класс объекта, "NSBlock".
OurBlock.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID);
// Указатель на наш коллбек. Это обычная функция cdecl, обявленная в нашем коде.
OurBlock.Invoke := @InvokeCallback;
// Аллоцируем память для Block_Descriptor
New(aDesc);
aDesc.Reserved := 0;
// прописываем размер
aDesc.Size := SizeOf(Block_Literal);
OurBlock.Descriptor := aDesc;

result:= @OurBlock;
end;


Поле flags мы пока оставляем нулевым, для простоты. Позже оно нам пригодится. Нам осталось задекларировать пока пустую функцию коллбека. Первым аргументом в коллбеке будет указатель на экземпляр класса NSBlock, а список остальных параметров зависит от конкретного метода Cocoa-класса, который будет вызывать code block. В примере выше, с NSSavePanel, это процедура с одним аргументом типа NSInteger. Так и запишем для начала:



procedure InvokeCallback (aNSBlock: pointer; i1: NSInteger); cdecl;
begin
Sleep(0);
end;


Ответственный момент, удар по воротам:



    FSaveFile := TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel);
NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd;
objc_msgSendP2(
(FSaveFile as ILocalObject).GetObjectID,
sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')),
(NSWin as ILocalObject).GetObjectID,
CreateBlock
);


Открывается диалог сохранения файла, мы жмем ОК или Cancel и … да! Мы попадем на break point, который поставили на Sleep(0), и да, в аргументе i1 будет либо 0, либо 1, в зависимости от того, какую кнопку в диалоге мы нажали. Победа! Мы с утенком счастливы, но впереди много работы:




  • Количество и тип аргументов коллбека могут быть разными. Есть определенные наиболее популярные наборы, но требуется гибкость.

  • У нас может быть в работе много код-блоков одновременно. Например, мы можем скачивать файл с вызовом completion handler по завершении и, параллельно, открывать и закрывать диалог сохранения файла. Сначала сработает код-блок, который мы создали вторым, а когда докачается файл, сработает первый код-блок. Хорошо бы вести учет.

  • Нам нужно как-то идентифицировать тот блок, который вызвал коллбек, и вызывать соответствующий этому блоку код Delphi.

  • Было бы здорово сделать мостик между анонимными методами в Delphi и код-блоками, без этого теряется всё удобство и красота. Хочется, чтобы вызов выглядел примерно так:



SomeNSClassInstance.SomeMethodWithCallback (
Arg1,
Arg2,
TObjCBlock.CreateBlockWithProcedure(
procedure (p1: NSInteger)
begin
if p1 = 0
then ShowMessage ('Cancel')
else ShowMessage ('OK');
end)
);


Начнем с вида коллбеков. Очевидно, что самый простой и самый надежный способ – иметь под каждый тип функции свой коллбек:



procedure InvokeCallback1 (aNSBlock: pointer; p1: pointer); cdecl;
procedure InvokeCallback2 (aNSBlock: pointer; p1, p2: pointer); cdecl;
procedure InvokeCallback3 (aNSBlock: pointer; p1, p2, p3: pointer); cdecl;


И так далее. Но как-то это нудно и неэлегантно, правда? Поэтому мысль ведет нас дальше. Что, если объявить только один вид коллбека, проидентифицировать блок, который вызвал коллбек, узнать число аргументов и поползти по стеку, читая нужное количество аргументов?



procedure InvokeCallback (aNSBlock: pointer); cdecl;
var
i, ArgNum: integer;
p: PByte;
Args: array of pointer;
begin
i:= FindMatchingBlock(aNSBlock);
if i >= 0 then
begin
p:= @aNSBlock;
Inc(p, Sizeof(pointer)); // Прыгаем в начало списка аргументов
ArgNum:= GetArgNum(...);
if ArgNum > 0 then
begin
SetLength(Args, ArgNum);
Move(p^, Args[0], SizeOf(pointer) * ArgNum);
end;
...
end;


Хорошая мысль? Нет, плохая. Это будет работать в 32-битном коде, но грохнется к чертовой матери в 64-битном, потому что никакого cdecl в 64-битном коде не бывает, а есть одна общая calling convention, которая, в отличие от cdecl, аргументы передает не в стэке, а в регистрах процессора. Ну что же, тогда поступим еще проще, объявим коллбек так:



function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl;


И просто будем читать столько аргументов, сколько нам нужно. В оставшихся аргументах будет мусор, но мы к ним и не будем обращаться. И заодно мы сменили procedure на function, на случай, если code block требует результата. Disclaimer: если вы не уверены в безопасности такого подхода, используйте отдельные коллбеки под каждый тип функции. Мне подход кажется довольно безопасным, но, как говорится, tastes differ.



Что касается идентификации блока, то тут всё оказалось довольно просто: aNSBlock, который приходит к нам, как первый аргумент в коллбеке, указывает ровно на тот же Descriptor, который мы аллоцировали при создании блока.



Теперь можно заняться анонимными методами разных типов, мы покроем процентов 90 из возможных наборов аргументов, которые встречаются на практике в классах macOS и мы всегда можем расширить список:



type

TProc1 = TProc;
TProc2 = TProc;
TProc3 = TProc;
TProc4 = TProc;
TProc5 = TProc;
TProc6 = TProc;
TProc7 = TFunc;

TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7);

TObjCBlock = record
private
class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static;
public
class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static;
class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static;
class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static;
class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static;
class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static;
class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static;
class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static;
end;


Таким образом, создание блока с процедурой, которая, например, имеет два аргумента размером SizeOf(pointer), будет выглядеть так:



class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer;
begin
result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3);
end;


CreateBlockWithCFunc выглядит так:



class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer;
begin
result:= BlockObj.AddNewBlock(aTProc, aType);
end;


То есть. мы обращается к BlockObj, singleton-экземпляру класса TObjCBlockList, который нужен для управления всем этим хозяйством и недоступен снаружи юнита:



  TBlockInfo = packed record
BlockStructure: Block_Literal;
LocProc: TProc;
ProcType: TProcType;
end;
PBlockInfo = ^TBlockInfo;

TObjCBlockList = class (TObject)
private
FBlockList: TArray;
procedure ClearAllBlocks;
public
constructor Create;
destructor Destroy; override;
function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer;
function FindMatchingBlock(const aCurrBlock: pointer): integer;
procedure ClearBlock(const idx: integer);
property BlockList: TArray read FBlockList ;
end;

var
BlockObj: TObjCBlockList;


"Сердце" нашего класса бьется тут:



function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer;
var
aDesc: PBlock_Descriptor;
const
BLOCK_HAS_COPY_DISPOSE = 1 shl 25;
begin
// Добавляем в наш массив блоков новый элемент и обнуляем его
SetLength(FBlockList, Length(FBlockList) + 1);
FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0);
// Это я уже объяснял выше
FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock')
as ILocalobject).GetObjectID);
FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback;
// Сообщаем системе, что наш блок будет иметь два доп. хелпера,
// для copy и displose. Зачем? Об этом ниже.
FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE;
// Сохраним тип нашего анонимного метода и ссылку на него:
FBlockList[High(FBlockList)].ProcType := aType;
FBlockList[High(FBlockList)].LocProc := aTProc;

New(aDesc);
aDesc.Reserved := 0;
aDesc.Size := SizeOf(Block_Literal);
// Укажем адреса хелпер-функций:
aDesc.copy_helper := @CopyCallback;
aDesc.dispose_helper := @DisposeCallback;
FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc;

result:= @FBlockList[High(FBlockList)].BlockStructure;
end;


Ну вот, всё основное мы написали. Остается всего несколько тонких моментов.



Во-первых, нам нужно добавить thread safety, чтобы с экземпляром класса можно было работать из разных нитей. Это довольно просто, и мы добавили соответствующий код.



Во-вторых, нам надо бы узнать, а когда же можно наконец "прибить" созданную нами структуру, т.е. элемент массива FBlockList. На первый взгляд кажется, что как только система вызвала коллбек, блок можно удалять: загрузился файл, был вызван completion handler – всё, дело сделано. На самом деле, это не всегда так. Есть блоки, которые вызываются сколько угодно раз; например, в методе imageWithSize:flipped:drawingHandler: класса NSImage нужно передать указатель на блок, который будет отрисовывать картинку, что, как вы понимаете, может происходить хоть миллион раз. Вот тут-то нам и пригодится aDesc.dispose_helper := @DisposeCallback. Вызов процедуры DisposeCallback как раз и будет сигнализировать о том, что блок больше не нужен и его можно смело удалять.



Вишенка на торте



А давайте еще self-test напишем, прямо в том же юните? Вдруг что-то сломается в следующей версии компилятора или при переходе на 64 бита. Как можно протестировать блоки, не обращаясь к Cocoa-классам? Оказывается, для этого есть специальные низкоуровневые функции, которые нам надо для начала задекларировать в Delphi так:



  function imp_implementationWithBlock(block: id): pointer; cdecl;
external libobjc name _PU + 'imp_implementationWithBlock';
function imp_removeBlock(anImp: pointer): integer; cdecl;
external libobjc name _PU + 'imp_removeBlock';


Первая функция возвращает указатель на C-функцию, которая вызывает блок, который мы передали как аргумент. Вторая просто "подчищает" потом память. Отлично, значит нам нужно создать блок с помощью нашего прекрасного класса, передать его в imp_implementationWithBlock, вызвать функцию по полученному адресу и с замиранием сердца посмотреть, как отработал блок. Пробуем всё это исполнить. Вариант первый, наивный:



class procedure TObjCBlock.SelfTest;
var
p: pointer;
test: NativeUint;
func : procedure ( p1, p2, p3, p4: pointer); cdecl;
begin
test:= 0;
p:= TObjCBlock.CreateBlockWithProcedure(
procedure (p1, p2, p3, p4: pointer)
begin
test:= NativeUint(p1) + NativeUint(p2) +
NativeUint(p3) + NativeUint(p4);
end);
@func := imp_implementationWithBlock(p);
func(pointer(1), pointer(2), pointer(3), pointer(4));
imp_removeBlock(@func);
if test <> (1 + 2 + 3 + 4)
then raise Exception.Create('Objective-C code block self-test failed!');
end;


Запускаем и… упс. Попадаем в анонимный метод: p1=1, p2=3, p3=4, p4=мусор. What the …? Кто съел двойку? И почему в последнем параметре мусор? Оказывается, дело в том, что imp_implementationWithBlock возвращает trampoline, который позволяет вызывать блок как IMP. Проблема в том, что IMP в Objective-C всегда имеет два обязательных первых аргумента, (id self, SEL _cmd), т.е. указатели на объект и на селектор, а код-блок имеет лишь один обязательный аргумент в начале. Возвращаемый trampoline при вызове редактирует список аргументов: второй аргумент, _cmd, выкидывается за ненужностью, на его место пишется первый аргумент, а вот на место первого аргумента подставляется указатель на NSBlock.



Да, вот так, trampoline подкрался незаметно. Ладно, вариант второй, правильный:



class procedure TObjCBlock.SelfTest;
var
p: pointer;
test: NativeUint;
func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl;
begin
test:= 0;
p:= TObjCBlock.CreateBlockWithProcedure(
procedure (p1, p2, p3, p4: pointer)
begin
test:= NativeUint(p1) + NativeUint(p2) +
NativeUint(p3) + NativeUint(p4);
end);
@func := imp_implementationWithBlock(p);
// Да, _cmd будет проигнорирован!
func(pointer(1), nil, pointer(2), pointer(3), pointer(4));
imp_removeBlock(@func);
if test <> (1 + 2 + 3 + 4)
then raise Exception.Create('Objective-C code block self-test failed!');
end;


Вот теперь всё проходит гладко и можно наслаждаться работой с блоками. Целиком юнит можно скачать тут или посмотреть ниже. Комментарии ("ламеры, у вас тут течет память") и предложения по улучшению приветствуются.



Полный сорс-код
{*******************************************************}
{ }
{ Implementation of Objective-C Code Blocks }
{ }
{ Copyright(c) 2017 TamoSoft Limited }
{ }
{*******************************************************}

{
LICENSE:

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

You may not use the Software in any projects published under viral licenses,
including, but not limited to, GNU GPL.

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE
}
//USAGE EXAMPLE
//
// FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel);
// NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd;
// objc_msgSendP2(
// (FSaveFile as ILocalObject).GetObjectID,
// sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')),
// (NSWin as ILocalObject).GetObjectID,
// TObjCBlock.CreateBlockWithProcedure(
// procedure (p1: NSInteger)
// begin
// if p1 = 0
// then ShowMessage ('Cancel')
// else ShowMessage ('OK');
// end)
// );

unit Mac.CodeBlocks;

interface

uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers,
Macapi.ObjCRuntime, Macapi.CocoaTypes;

type

TProc1 = TProc;
TProc2 = TProc;
TProc3 = TProc;
TProc4 = TProc;
TProc5 = TProc;
TProc6 = TProc;
TProc7 = TFunc;

TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7);

TObjCBlock = record
private
class procedure SelfTest; static;
class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static;
public
class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static;
class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static;
class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static;
class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static;
class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static;
class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static;
class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static;
end;

implementation

function imp_implementationWithBlock(block: id): pointer; cdecl;
external libobjc name _PU + 'imp_implementationWithBlock';
function imp_removeBlock(anImp: pointer): integer; cdecl;
external libobjc name _PU + 'imp_removeBlock';

type

Block_Descriptor = packed record
Reserved: NativeUint;
Size: NativeUint;
copy_helper: pointer;
dispose_helper: pointer;
end;
PBlock_Descriptor = ^Block_Descriptor;

Block_Literal = packed record
Isa: pointer;
Flags: integer;
Reserved: integer;
Invoke: pointer;
Descriptor: PBlock_Descriptor;
end;
PBlock_Literal = ^Block_Literal;

TBlockInfo = packed record
BlockStructure: Block_Literal;
LocProc: TProc;
ProcType: TProcType;
end;
PBlockInfo = ^TBlockInfo;

TObjCBlockList = class (TObject)
private
FBlockList: TArray;
procedure ClearAllBlocks;
public
constructor Create;
destructor Destroy; override;
function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer;
function FindMatchingBlock(const aCurrBlock: pointer): integer;
procedure ClearBlock(const idx: integer);
property BlockList: TArray read FBlockList ;
end;

var
BlockObj: TObjCBlockList;

function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl;
var
i: integer;
aRect: NSRect;
begin
result:= nil;
if Assigned(BlockObj) then
begin
TMonitor.Enter(BlockObj);
try
i:= BlockObj.FindMatchingBlock(aNSBlock);
if i >= 0 then
begin
case BlockObj.BlockList[i].ProcType of
TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)();
TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1);
TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2);
TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3);
TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4);
TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1));
TProcType.pt7:
begin
aRect.origin.x := CGFloat(p1);
aRect.origin.y := CGFloat(p2);
aRect.size.width := CGFloat(p3);
aRect.size.height:= CGFloat(p4);
result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect));
end;
end;
end;
finally
TMonitor.Exit(BlockObj);
end;
end;
end;

procedure DisposeCallback(aNSBlock: pointer) cdecl;
var
i: integer;
begin
if Assigned(BlockObj) then
begin
TMonitor.Enter(BlockObj);
try
i:= BlockObj.FindMatchingBlock(aNSBlock);
if i >= 0
then BlockObj.ClearBlock(i);
finally
TMonitor.Exit(BlockObj);
end;
end;
TNSObject.Wrap(aNSBlock).release;
end;

procedure CopyCallback(scr, dst: pointer) cdecl;
begin
//
end;

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer;
begin
result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1);
end;

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer;
begin
result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2);
end;

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer;
begin
result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3);
end;

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer;
begin
result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4);
end;

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer;
begin
result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5);
end;

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer;
begin
result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6);
end;

class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer;
begin
result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7);
end;

class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer;
begin
result:= nil;
if Assigned(BlockObj) then
begin
TMonitor.Enter(BlockObj);
try
result:= BlockObj.AddNewBlock(aTProc, aType);
finally
TMonitor.Exit(BlockObj);
end;
end;
end;

class procedure TObjCBlock.SelfTest;
var
p: pointer;
test: NativeUint;
// Yes, _cmd is ignored!
func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl;
begin
test:= 0;
p:= TObjCBlock.CreateBlockWithProcedure(
procedure (p1, p2, p3, p4: pointer)
begin
test:= NativeUint(p1) + NativeUint(p2) +
NativeUint(p3) + NativeUint(p4);
end);
@func := imp_implementationWithBlock(p);
// Yes, _cmd is ignored!
func(pointer(1), nil, pointer(2), pointer(3), pointer(4));
imp_removeBlock(@func);
if test <> (1 + 2 + 3 + 4)
then raise Exception.Create('Objective-C code block self-test failed!');
end;

{TObjCBlockList}

constructor TObjCBlockList.Create;
begin
inherited;
end;

destructor TObjCBlockList.Destroy;
begin
TMonitor.Enter(Self);
try
ClearAllBlocks;
finally
TMonitor.Exit(Self);
end;
inherited Destroy;
end;

procedure TObjCBlockList.ClearBlock(const idx: integer);
begin
Dispose(FBlockList[idx].BlockStructure.Descriptor);
FBlockList[idx].BlockStructure.isa:= nil;
FBlockList[idx].LocProc:= nil;
Delete(FBlockList, idx, 1);
end;

function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer;
var
aDesc: PBlock_Descriptor;
const
BLOCK_HAS_COPY_DISPOSE = 1 shl 25;
begin
SetLength(FBlockList, Length(FBlockList) + 1);
FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0);

FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID);
FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback;
FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE;
FBlockList[High(FBlockList)].ProcType := aType;
FBlockList[High(FBlockList)].LocProc := aTProc;

New(aDesc);
aDesc.Reserved := 0;
aDesc.Size := SizeOf(Block_Literal);
aDesc.copy_helper := @CopyCallback;
aDesc.dispose_helper := @DisposeCallback;
FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc;

result:= @FBlockList[High(FBlockList)].BlockStructure;
end;

procedure TObjCBlockList.ClearAllBlocks();
var
i: integer;
begin
for i := High(FBlockList) downto Low(FBlockList) do
ClearBlock(i);
end;

function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer;
var
i: integer;
begin
result:= -1;
if aCurrBlock <> nil then
begin
for i:= Low(FBlockList) to High(FBlockList) do
begin
if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor
then Exit(i);
end;
end;
end;

initialization
BlockObj:=TObjCBlockList.Create;
TObjCBlock.SelfTest;

finalization
FreeAndNil(BlockObj);

end.

Original source: habrahabr.ru (comments, light).

https://habrahabr.ru/post/325204/

Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
rss_rss_hh_new

[Из песочницы] Безболезненная прививка объектного мышления

Вторник, 28 Марта 2017 г. 11:19 (ссылка)

https://habrahabr.ru/post/325010/

Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
rss_rss_hh_new

JNI Получение и Подключение к JVM в Delphi

Среда, 22 Марта 2017 г. 15:39 (ссылка)

Всем доброго времени суток!

Сегодня разберем пример как получить загруженную JVM и подключиться к ней. Нужно нам это для того что выполнить внутри JVM некий код.

И так приступим:



Создаем новый проект DLL. Добавим Process Attach:



procedure DllMain(dwReason: LongWord);
begin
case dwReason of
DLL_PROCESS_ATTACH:
begin
//**************************
end;
DLL_PROCESS_DETACH:
begin
//***************************
end;
end;
end;

begin
DllProc := @DllMain;
DllProc(DLL_PROCESS_ATTACH);
end.




Отлично добавили. Далее нас потребуется в Uses добавить компонент JNI:



uses
System.SysUtils,
System.Classes,
windows,
JNI;




А теперь давайте реализуем поиск и подключение к JVM, Для этого в DllMain добавим переменные:



var
I: Integer;
JVMArray: array of PJavaVM;
NumberOfVMs: JSize;
JNIEnv: PJNIEnv;
GetCreatedJavaVMs: TJNI_GetCreatedJavaVMs;
const
BufferSize = 128;




Далее в DLL_PROCESS_ATTACH: реализуем поиск и подключение загруженной JVM



begin
try
GetCreatedJavaVMs := GetProcAddress(GetModuleHandle('jvm.dll'), 'JNI_GetCreatedJavaVMs');
SetLength(JVMArray, BufferSize);
GetCreatedJavaVMs(@JVMArray[0], BufferSize, @NumberOfVMs);
except
Exit;
end;
if NumberOfVMs > 0 then
begin
for I := 0 to NumberOfVMs - 1 do
begin
JVMArray[I]^.GetEnv(JVMArray[I], @JNIEnv, JNI_VERSION_1_8);
JVMArray[I]^.AttachCurrentThread(JVMArray[I], @JNIEnv, Nil);
end;
end
else
begin
Exit;
end;




Что же тут происходит. Для начала нам нужно получить адрес функции JNI_GetCreatedJavaVMs из jvm.dll. Затем установим длину буфера. Затем используем функцию GetCreatedJavaVMs для получения всех загруженных JVM. Ну а дальше просто отсев в буфере пока не останется именно та загруженная JVM и подключаемся к ней AttachCurrentThread.

И так мы нашли и подключились к загруженной JVM. Теперь можно использовать любой код внутри JVM после строчки AttachCurrentThread.

Теперь просто скомпилируем DLL и любым инжектором DLL засунем её в Java процесс.
Original source: habrahabr.ru (comments, light).

https://habrahabr.ru/post/324594/

Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
rss_rss_hh_new

[Из песочницы] JNI и Delphi. Примеры

Среда, 22 Марта 2017 г. 10:48 (ссылка)

Использование JNI в Delphi



Приветствую всех. Эта статья рассчитана для Новичков, которые только приступили к изучению JNI для работы с ним в среде Delphi. И так в этой статье мы поговорим как именно использовать JNI в Delphi. И так давайте же приступим.



Для начала вам потребуется компонент JNI. Вы можете его скачать ТУТ. Теперь мы готовы приступить к практической части. Я все буду делать на RAD Studio 10.1 Berlin



Пример №1:

Получаем и изменяем данные типа JInt, JBoolean.



Допустим что у нас есть Класс в котором есть переменная I типа JInt, следовательно нам нужно ее изменить.



public int I = 10;


И есть некий обработчик который использует эту переменную. К примеру Событие нажиния TButton.



 private void jButton1ActionPerformed(java.awt.event.ActionEvent evt) {                                         
System.out.println(i);
}


При нажатии на Кнопку в консоль выведется сообщение «10» т.к. I = 10; Чтобы нам изменить I на любое другое число, делаем следующее:



var
JNIEnv: PJNIEnv;
JC: JClass;
JF: JFieldID;
Begin
JC:= jnienv^.FindClass(JNIEnv, 'example/Main');
JF:= jnienv^.GetFieldID(JNIEnv, JC, 'I', 'I');
jnienv^.SetIntField(JNIEnv, JC, JF, 5);
end;


Что же тут происходит. Для начала мы получаем JavaClass функцией FindClass. 'example/Main' это значит что класс находится внутри JVM по пути example\Main.class.



Далее мы получаем JField в данном случае это I типа JInt. GetFieldID мы указываем Класс, Имя и Сигнатуру.



И наконец мы передаем свое значение I, в моем случаем оно равно 5. SetIntField мы указываем Класс, JField и значение.



То же самое будет для JBoolean:



 public boolean Stat = false;




 var
JNIEnv: PJNIEnv;
JC: JClass;
JF: JFieldID;
Begin
JC:= jnienv^.FindClass(JNIEnv, 'example/Main');
JF:= jnienv^.GetFieldID(JNIEnv, JC, 'Stat', 'Z');
jnienv^.SetByteField(JNIEnv, JC, JF, 1);
end;


Изначально Stat был равен false т.е. 0, а мы его меняем на true т.е. 1;



Пример №2:

Обращение к процедуре Void()



Допустим у нас есть некая статичная процедура в которой выполняется некий сценарий. Процедура будет выполняться при нажатии на кнопку. Для того чтобы выполнить эту процедуру будем делать обращение к Методу.



 public static void Push()
{
System.out.println("Hello");
}


Как мы видим эта процедура будет просто выводить в Консоль «Hello». Чтобы вызвать исполнение этой процедуры делаем следующее:



var
JNIEnv: PJNIEnv;
JC: JClass;
JM: JMethodID;
Begin
JC:= jnienv^.FindClass(JNIEnv, 'example/Main');
JM:=jnienv^.GetStaticMethodID(JNIEnv, JC, 'Push', '()V');
jnienv^.CallStaticVoidMethod(JNIEnv, JC, JM);
end;


Что же тут происходит. Мы получаем Статический Метод Push. GetStaticMethodID где мы указали Класс, Имя и Сигнатуру.



И вызываем его на исполнение CallStaticVoidMethod где мы указали Класс и Метод.



Пример №3

Обращение к функции с переменной JInt.



Допустим у нас есть некая функция у которой есть переменная I типа JInt. И результат выполнения является JInt, а некий сценарий внутри функции выдает в Консоль некие сообщения



public static int Num(int i) 
{
for (int s=0; scode>


По сути в консоль будет выдаваться I количество сообщений «Example». Давай рассмотрим обращение к такой функции.



var
JNIEnv: PJNIEnv;
JC: JClass;
JM: JMethodID;
Begin
JC:= jnienv^.FindClass(JNIEnv, 'example/Main');
JM:=jnienv^.GetStaticMethodID(JNIEnv, JC, 'Num', '(I)I');
jnienv^.CallStaticVoidMethodV(JNIEnv, JC, JM, '5');
end;


Что же тут происходит. Мы находим Нужный Метод. И производим вызов его, но в этот с указанием JInt. В данном случае это 5.



И так результат выполнения этой функции будет вывод в Консоль 5 раз сообщений «Example»
Original source: habrahabr.ru (comments, light).

https://habrahabr.ru/post/324552/

Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
rss_rss_hh_new

Blast-off. От идеи до релиза

Вторник, 14 Марта 2017 г. 15:29 (ссылка)

Всем привет! Я хочу рассказать историю разработки игры на Delphi от идеи до релиза.

Статья больше носит характер истории, без вникания в подробности реализации. Честно говоря, очень хочется написать про то, как мы строим картинку в игре, или локализуем её, как мы делали GUI, но это я выделю в отдельную статью, больше техническую, с кодом. Иначе эта окажется слишком большой. Кода тут не будет, но детали под катом. Прошу!







Application.Initialize;



Итак. Игра наша придумана была давно для конкурса разработки игр (джема) IGDC №77 — джампер Это было начало 2012 года. Игру мы делали в состоянии перманентного кранча аж две недели. Код вышел ужасным. Расширять было невозможно, порой возникали необъяснимые глюки, но в целом игра работала и некоторые товарищи умудрялись проводить в ней дни, недели. Пара человек залипали в течение месяца. Стало понятно, что реиграбельность у неё хорошая и надо бы её доделывать. Но, как я сказал выше, код был ужасен из-за скомканных сроков, так что доделок было сделано не очень много и всё благополучно забыто.



Выглядело это тогда так:







Для сравнения сейчас это выглядит так:







While true do



Забыто было почти до 2014 года. Тогда мы собрались и начали делать всё снова. С капитальным подходом к архитектуре. Были заложены такие вещи как менеджер игровых режимов, система динамической локализации, поддержка любых разрешений, достижения и прочее, прочее, прочее… Всё на классах, всё унаследовано, перекрыто. Что не в классах, а глобально, то в статических классах. Вообщем подошли к вопросу очень отвественно. Про игру, правда, около года благополучно забывали. Было там что-то, отдаленно напоминающее давний прототип, но до него не дотягивало ни по контенту, ни по интересности. Прокрастинировали активно и долго, короче. Вот меню именно тогда собрали, я сделал планеты и даже статью по ним на хабре.





Польза от такой прокрастинации, тем не менее, была. Позже все эти вещи помогли избежать вороха проблем, поскольку были реализованы в фундаменте. Локализация, например, была решена посредством XML файлов, прямо перед релизом к нам постучался итальянец, Франческо и предложил перевести игру. Сделал всё сам, мы нарисовали нужные символы в шрифте и игра за неделю обзавелась итальянским. Легко и просто. Из этого как минимум один вывод сделать стоит — не забивайте на локализацию, сделайте её пораньше. И желательно не в ущерб геймплею.







For feature in coolthings do



Когда мы начали делать игру, мы смотрели, на лучшие моменты в разных играх, но больше всего оглядывались на Blizzard. О да, это очень крутая контора, они делают крутые игры и каждая хит. А еще каждая проработана до мелочей. И это нас безумно цепляло. Поэтому я, как поклонник Diablo и мой коллега как поклонник WarCraft и StarCraft смотрели на них часто. Так было решено что, например, достижения или друзей надо иметь возможность просматривать прямо из игры, без оверлеев или выхода. Так и появились такие мелочи, как часы в углу, как затухающая музыка при alt+tab, возможность прослушать любой трек из меню, в любой момент подключить геймпад и играть не перезапуская, показывать достижения прямо в игре и многое другое.







Игру мы делали почти всё время вдвоем. Два программиста. Графику или рисовал сам, или генерировал спрайты с помощью FilterForge Под конец разработки мы заказали графику для врагов, купили иконки в ассетсторе, звуки. Музыку нам делали на заказ и музыка появилась еще год назад. Музыку не просто написали нам, так еще и сводили на проф. оборудовании в студии. Треки получились отличные, и очень в настроение игры.



Небольшие отрывки музыки












Case build of release



Код. Код мы пишем на Delphi 10.1 на текущий момент, а движок используем свой Quad-engine, тоже написанный на делфи с открытым исходным кодом. Разработка игры, кстати, безумно помогает сделать движок действительно полезным и удобным. Мы давно работаем в делфи и нам удобен этот инструмент, но даже тут не обошлось без косяков. В одном из модулей GUI сборка под релиз и дебаг работала по разному. Внезапно оказалось, что пункт «оптимизация» в релизной версии почему-то делает одну из переменных True в случаях, когда она должна быть False. И GUI начинает вести себя неадекватно. Ассемблерный код разный и результат тоже. Решение выбрано не самое лучшее было, но мы отключили пункт «оптимизация» воимя одинакового с дебагом результата.



Во время разработки мы столкнулись с тем, что пришлось выкинуть почти все наработки по геймплею за почти что год, и переделать все заново. Отказаться пришлось и от Box2D, сильно осложняющим решение наших задач. Одна из проблем была в том, что Box2D всё считает в мировых координатах, а у нас скорости и вектора могут быть очень большими. На потерях точности возникали проблемы. Например пушка босса могла отставать от босса. Его расчеты проходили итеративно, как бы мы не старались (возможно плохо старались), но нам не удавалось достаточно синхронизировать картинку с физикой. Поэтому мы взяли и воспользовались своей физикой из прототипа, разумеется с доработками. Например все расчеты визики у нас проиходят в экранных координатах, что решает проблему огромных скоростей и значений. Физика из прототипа умела работать только с горизонтальной линией и кружочками. Здесь же физику научили и другим фигурам. соединениям, слоям, типам объектов и пр.

Также мы сделали хорошую систему частиц, но она не пригодилась. Не пригодился и наикрутейший редактор в стиле Warcraft3, позволяющий мышкой делать всё что угодно. В меру своей сложности и запутанности связывать его с достижениями, например оказалось сущим адом. Так было выкинуто суммарно около года разработки моего коллеги ZblCoder. И он начал писать весь геймплей снова. Но на удивление наверстали мы всё менее чем за месяц, а дальше пошел рост.

В итоге, в сухом остатке, можно сказать, что где-то из трёх лет разработки (были перерывы довольно длительные, так что реально затрачено было 1.5-2 года свободных вечеров) можно было бы игру сделать вдвое быстрее, не делай мы ненужных вещей. Но без граблей обойтись невозможно, поэтому времени ушло много. Основа графического движка к тому моменту была уже вовсе не основой. Я реализовал огромное количество шейдерных эффектов, и безшейдерных трюков для достижения сочной, динамичной картинки.







Game.Draw;



Нормалмаппинг, объемное освещение, искажения пространства, параллакс маппинг и куча более мелких, но не менее важных шейдеров. Шейдерами делается практически всё. От цветокоррекции до переливания щитов. Многие эффекты вы можете и не заметить, или подумать что они нарисованы заранее, но нет. Они делаются «на лету».

Вот, например, скриншот без цветокоррекции:







IsThereTroubles: Boolean; abstract;



Многие из тех, кто играли, утверждали потом, что скриншоты и видео не передают вообще никак настроение и увлекательность процесса, пускай и довольно простого. И эту проблему мы так и не смогли решить. Как же показать что оно интереснее, чем выглядит?



Основной проблемой до сих пор остаётся баланс. Для одних игра достаточно проста, для других невообразимо сложна. В большинстве случаев сложной она кажется оттого, что люди начинают без разбора стрелять во всё что движется, игнорируя подсказки и пытаясь действовать интуитивно, но неверно. Некоторое время спустя приходит осознание и человек начинает понимать как играть, получать удовольствие и снимать стресс.



Для подогрева интереса к игре, чтобы игрок не разочаровался в себе и не бросил сразу, если дела идут не очень круто, мы добавили в игру соревновательную составляющую. Определенные виды статистики сохраняются и друзья могут сравнить свои результаты с вами, а вы с друзьями. Кроме того опыт и открывание новых умений с каждым «левелапом» тоже помогает посидеть в игре чуточку дольше.







Target platforms (Win32)



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

Другой интересной проблемой стало падение Steamworks API при попытке получения информации о друзьях. На наших аккаунтах с 40-50 друзей все было «ОК», но вот у стримеров и летсплееров, где друзей было по 500+ оно где-то посередине списка падало по необъяснимым причинам. Так мы чуть не упустили еще пару стримеров, но поправить удалось очень быстро. В тот же день был сделан хотфикс.







Дальнейшая судьба игры — доработка, расширение. Крайне с удовольствием слушаем любую обратную связь, предпринимаем действия, помогающие сделать всё еще лучше. Сделаем Делфи снова великим!

Я добавил небольшой опрос в конце, буду благодарен за честный ответ.



О чем из нашей игры было бы интересно почитать подробно в следующей статье?


























































Проголосовало 4 человека. Воздержавшихся нет.





Только зарегистрированные пользователи могут участвовать в опросе. Войдите, пожалуйста.


Original source: habrahabr.ru (comments, light).

https://habrahabr.ru/post/323898/

Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество

Следующие 30  »

<delphi - Самое интересное в блогах

Страницы: [1] 2 3 ..
.. 10

LiveInternet.Ru Ссылки: на главную|почта|знакомства|одноклассники|фото|открытки|тесты|чат
О проекте: помощь|контакты|разместить рекламу|версия для pda