Реализация perl под Windows не предоставляет возможности работать с окнами. Однако, perl так же и не страдает манией величия (под видом претендента на место языка с исчерпывающими возможностями) и позволяет добавлять отсутствующие механизмы с помощью модулей.
Ближе к делу

Что такое API все знают? Правильно, это программный интерфейс, который связывает разные части программы. Так вот, в операционных системах Windows доступ к различным механизмам системы обеспечивается посредством функций специального интерфейса - WinAPI. Так как система довольно сложна, различных механизмов в ней достаточно. В связи с этим, WinAPI может предстать перед программистом довольно пухлой программной прокладкой. Здесь уже без справочника не обойтись. Хорошо то, что как ни крути, WinAPI одно и для C, и для Delphi и для других языков. Если бы в perl можно было напрямую работать со стеком и вызывать функций по указателю, то нам не пришлось бы лезть в C. Однако, по вполне понятным причинам такого механизма в perl нет. И, во всяком случае, если вы знаете что такое стек и как с ним работать, то несколько строк на C вас нисколько не испугают. В общем решение здесь одно - создать модуль, через который программа на perl получит доступ к нужным функциям WinAPI.

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

Пора открывать справочник по функциям WinAPI и выявлять все необходимые функции. Ниже перечисляются функции которые нам понадобятся.

* RegisterClass() - регистрация класса окна
* CreateWindow() - создание экземпляра окна
* ShowWindow() - перерисовать окно
* UpdateWindow() - обновить окно
* SendMessage() - отправить окну сообщение и дождаться результата
* PostMessage() - отправить окну сообщение
* DestroyWindow() - уничтожить окно

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

Теперь нужно подумать о схеме. Как мы будем реализовывать perl-интерфейс к этим функциям? Самый простой вариант - это с помощью XSUB написать функции преобразования параметров, передаваемых из perl, в доступный для WinAPI вид. Однако, лучшим решением будет реализация объектного интерфейса. При этом, нужно будет разделить этапы создания окна и процесс обработки очереди сообщений. Это может понадобиться в случае если мы захотим работать с несколькими окнами в одном приложении. Для этого, нам понадобятся дескрипторы всех окон. К тому же, обработка очереди сообщений для каждого из этих окон может быть вынесена в отдельный процесс.

Для большинства оконных функций требуется только дескриптор окна. Мы будем сохранять дескриптор окна в переменной объекта класса, код которого будет реализовываться моделум WinApp.pm. Таким образом, мы избавляемся от необходимости забивать голову ненужной заботой об объектном интерфейсе на уровне XSUB.

С помощью команды

h2xs -A -n WinApp

создаем новый проект. Нозвание не совсем точно определяет цель, но просто Window было бы еще непонятнее. Заходим в каталог созданного проекта и, первым делом, создаем файл typemap. Напомню, что содержимое этого файла определяет правила приведения типов для неизвестных XSUB типов. Сначала определим порядок преобразования базовых типов

BOOL T_IV DWORD T_UV UINT T_UV HWND T_UV

Далее, беремся за файл WinApp.xs, который будет содержать гибрид C-кода и XSUB-директив. Не забываем подключить заголовочный файл windows.h, в противном случае компилятор не увидит определений необходимых функций и ресурсов. Добавляем сразу в начало файла строку

#include

Регистрируем класс окна

Функция RegisterClass() имеет следующий прототип

ATOM RegisterClass(CONST WNDCLASS *lpWndClass);

Ясно, что дело темное. Из этого прототипа мы не можем сделать каких либо полезных выводов. Лезем в справочник и выковыриваем оттуда описание структуры WNDCLASS

typedef struct _WNDCLASS { // wc UINT style; WNDPROC lpfnWndProc; int cbClsExtra; int cbWndExtra; HANDLE hInstance; HICON hIcon; HCURSOR hCursor; HBRUSH hbrBackground; LPCTSTR lpszMenuName; LPCTSTR lpszClassName; } WNDCLASS;

Мы не будем рассматривать все поля этой структуры. Для нас первостепенное значение представляют поля lpfnWndProc и lpszClassName. Поле style то же имеет значение, однако, мы обойдемся минимумом, определив значение с помощью констант CS_HREDRAW | CS_VREDRAW. Существуют еще несколько констант, описывающих возможные стили класса. Если сей факт представляет для вас интерес, загляните в документацию по WinAPI. Константы CS_HREDRAW и CS_VREDRAW говорят о том, что при изменении размеров клиентской части окна (например, пользователь выполнил захват ребра и выполняет перемещение курсора) необходимо перерисовывать окно.

Поле lpfnWndProc наиболее важно для класса, так как это поле содержит адрес функции, выполняющей обработку сообщений. Прототип этой функции жестко определен системой. Вместе с осознанием значения поля lpfnWndProc должно придти и понимание того, что просто так подсунуть перловую функцию не получится. Придется писать дополнительный код, который будет посредником между системой и обработчиком сообщений, реализованным на perl. При чем, делать это придется до того как приступить к реализации XSUB-версии RegisterClass(). Иначе толку от вызова RegisterClass() будет "как от козла молока".

Вот так должна выглядеть функция обработки сообщений

LRESULT CALLBACK WindowProc( HWND hwnd, // handle of window UINT uMsg, // message identifier WPARAM wParam, // first message parameter LPARAM lParam // second message parameter );

С помощью XSUB мы можем выполнить вызов функции, находящейся на территории perl, но для этого необходимо знать полное имя функции. А что толку знать имя функции на этапе регистрации окна? Мдяяя, замкнутый круг какой-то получается: что бы вызвать RegisterClass() нужно иметь функцию обработки сообщений. Ну ладно, мы решили, что напишем отдельную функцию на C и она, в свою очередь, будет форвардить масяги на территорию perl-кода. Но как этой самой С-функции передать имя нашей функции на perl?

Мы поступим хитро и немного изменим схему работы. Не задумываясь на тем, как идентифицировать callback-perl функцию на этапе регистрации окна мы укажем в качестве обработчика функцию, на которую возложим передачу сообщений в perl. А непосредственно идентификацию perl-функции обработки сообщений мы будем указывать во время создания экземпляра окна. Таким образом мы только увеличим гибкость, позволяя каждому окну сопоставлять персональный обработчик сообщений и это, заметьте, независимо от класса.

А сейчас давайте просто определим пустой обработчик сообщений, не задумываясь над реализацией связи с perl. Назовем функцию WndProc и разместим ее естественно в файле WinApp.xs но не после директив XSUB MODULE и PACKAGE, а до них (то есть между директивами препроцессора #include и первыми XSUB-директивами MODULE и PACKAGE).

LRESULT CALLBACK WindowProc(HWND hWnd, UINT uMsg,DWORD wParam,DWORD lParam) { return DefWindowProc(hWnd,uMsg,wParam,lParam); }

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

Функция DefWindowProc() представляет собой дефолтный обработчик сообщений. Ее вызов связан с тем, что каждое сообщение должно быть обработано (иначе в очереди будет бардак). Так вот, если вы не определяете обработчик для какого нибудь сообщения, то будьте добры вызовите DefWindowProc() - уж она то со всеми разберется. На вышеописанное следует обратить удвоенное внимание, так как мы имеем дело с сопряжением двух языков. В процесе разработки общего подхода я наступил на грабли, связанные с различным представлением значений в perl и C. Удар этими граблями образовал на моей голове очаровательную (почти в сутки величиной) шишку, смысл которой заключался в категорическом отказе приложения перерисовывать окно. А все из-за такого пустяка, как игнорирование дефолтного обработчика.

Ну, хватить философствовать, подошло время для реализации XSUB RegisterClass(). Давайте вернемся к структуре WNDCLASS и определим, какие параметры нужно получить, что бы зарегистрировать класс. Функция обработчик (на стороне C) у нас уже есть. Остается всего один параметр - имя класса. У меня такое ощущение, что в скором времени нам будет мало вот такой реализации. В связи с этим, предлагаю не испытывать судьбу и на всякий случай вторым параметром потребовать передачи значения для поля style.

Возвращать мы будем булево значение, сигнализирующее о результате регистрации класса. Значение 0 будет свидетельствовать об ошибке, любое положительно - об успехе. Вот так выглядит XSUB для вызова RegisterClass()

int _RegisterClass(szClassName,dwStyle) LPCTSTR szClassName; DWORD dwStyle; INIT: WNDCLASS wcl; wcl.style = dwStyle; wcl.lpfnWndProc = (WNDPROC)WindowProc; wcl.cbClsExtra = 0; wcl.cbWndExtra = 0; wcl.hInstance = NULL; wcl.hIcon = NULL; wcl.hCursor = NULL; wcl.hbrBackground = (HBRUSH)(COLOR_WINDOW+1); wcl.lpszMenuName = NULL; wcl.lpszClassName = szClassName; CODE: RETVAL = RegisterClass(&wcl); OUTPUT: RETVAL

Если попробовать собрать проект, xsubpp выдаст ошибку, мол, я не знаю кто такой LPCTSTR. И правильно сделает, ведь мы не добавили в файл typemap соответствующие определения. Отредактируйте typemap, что бы его содержимое было следующим

BOOL T_IV DWORD T_UV UINT T_UV HWND T_UV LPSTR T_PV LPCTSTR T_PV

Вот теперь можно и попробовать собрать. Сразу будем тестировать каждую добавляемую функцию, что бы в последствии не заботиться об этом. Для этого, в файле test.pl напишем тест под номером 2

# Тестируем функцию регистрации класса my $className = 'WinApp class'; my $style = 3; # CS_HREDRAW | CS_VREDRAW my $atom = _RegisterClass($className,$style); print $atom ? "" : "not ","ok 2\n";

Не забываем об экспорте имени функции в модуле WinApp.pm

our @EXPORT = qw( &_RegisterClass );

Теперь можно проверить. Выполняем команду

nmake test

Результат должен быть следующим

1..1 ok 1 ok 2

Ага, забыли поправить количество тестов в конструкторе модуля test.pl. Исправляем, запускаем. Все должно быть верно

BEGIN { $| = 1; print "1..2\n"; } END {print "not ok 1\n" unless $loaded;} use WinApp; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): # Тестируем функцию регистрации класса my $className = 'WinApp class'; my $style = 3; # CS_HREDRAW | CS_VREDRAW my $atom = _RegisterClass($className,$style); print $atom ? "" : "not ","ok 2\n";

Для того, что бы определить значение логичесткого объединения констант CS_HREDRAW и CS_VREDRAW нам придется заглянуть в заголовочный файл winuser.h. CS_VREDRAW сопоставлено значение 1, а CS_HREDRAW, соответственно, 2. 1 or 2 = 3. Вот таким образом мы получаем знаечние для определения стиля класса.
Создание экземпляра окна

Функция WinAPI CreateWindow() позволяет создать новое окно на основе имени класса. Вот её прототип

HWND CreateWindow( LPCTSTR lpClassName, LPCTSTR lpWindowName, DWORD dwStyle, int x, int y, int nWidth, int nHeight, HWND hWndParent, HMENU hMenu, HANDLE hInstance, LPVOID lpParam );

Как видим, довольно много аргументов, хотя назначение каждого из них вполне ясно из названий. Первым аргументом необходимо передать имя класса окна, то самое, которое использовалось при регистрации. Параметр lpWindowName, проще говоря, заголовок окна. Далее следует параметр, определяющий стиль окна. Всевозможных констант, определяющих стиль окна, очень много. Эти константы определены в заголовочном файле winuser.h. Мы не будем рассматривать все возможные значения (для этого есть справочник WinAPI) а за основу возьмем наиболее часто-встречающийся стиль.

Следующие четыре значения однозначно определяют положение и размеры окна. hWndParent - определяет дескриптор родительского окна (в случае, если мы создаем несколько окон, образуется иерархия подчинения). Следующие два параметры нас не слишком интересуют, думаю и так понятно, что они из себя представляют. Однако, последний параметр мы будем использовать. Как? Читаейте дальше.

XSUB реализация для этой функции у нас будет называться _CreateWindow(). В качестве аргументов мы будем передавать имя класса, заголовок окна, стиль, размеры и имя (заметьте, не указатель) функции обработчика на perl.

Теперь необходимо немного углубиться в порядок действий системы при создании нового окна. Прежде всего, мы знаем, что классу окна уже сопоставленн обработчик сообщений (в процессе регистрации класса). Это значит, что уже в момент вызова CreateWindow() система может вызывать обработчик сообщения, при том, что окна еще не существует. Фактом создания окна мы будем считать получение от функции CreateWindow() дескриптора созданного окна. Как вы понимаете, только после этого наше окно сможет, так сказать, приносить пользу. А без дескриптора нам не нужно никакое окно, ведь мы ему даже и сообщение послать не сможем.

Но, вернемся к функции обработки сообщений. Мы определили обработчик только для C-части расширения. То есть, если до создания окна будет вызван обработчик сообщения, то этот самый обработчик ничего полезного сделать не сможет, так как он понятия не имеет, какую функцию perl ему нужно вызывать. Однако, все не так уж плохо - выход есть. Если вникнуть в документацию, то можно обнаружить возможность передачи указателя на данные любого типа с помощью последнего аргумента функции CreateWindow().

Мы совершенно верно предположили, что обработчик сообщений может (и, как мы увидем далее, будет) вызываться до того, как фактически окно будет создано. Сразу скажу, что создание окна связано с обработкой сообщения WM_CREATE. В документации WinAPI сказано, что сообщение WM_CREATE посылается обработчику, когда поступает запрос на создание окна функциями CreateWindow() или CreateWindowEx(). При этом, lParam, передаваемый в качестве последнего аргумента обработчика, является указателем на экземпляр структуры типа CREATESTRUCT, которая содержит информацию о создаваемом окне. Для такого простого случая как наш, этот указатель можно было спокойно проигнорировать, если бы не возможность получения указателя, переданного функции CreateWindow() в качестве последнего аргумента. В нашем случае, это полное имя perl-функции обработчика сообщений.

Давайте проведем небольшой эксперимент, подтверждающий пригодность использования нашей схемы. В конец файла WinApp.xs добавляем следующий код

HWND _CreateWindow(szClassName,szTitle,dwStyle,x,y,dwWidth,dwHeight,szCallbackName) LPCTSTR szClassName; LPCTSTR szTitle; DWORD dwStyle; int x; int y; DWORD dwWidth; DWORD dwHeight; LPCTSTR szCallbackName; CODE: RETVAL = CreateWindow(szClassName,szTitle,dwStyle,x,y, dwWidth,dwHeight,NULL,NULL,NULL,(LPVOID)szCallbackName); OUTPUT: RETVAL

А функцию обработки сообщений изменим следующим образом

LRESULT CALLBACK WindowProc(HWND hWnd, UINT uMsg,DWORD wParam,DWORD lParam) { LPCREATESTRUCT cs; switch(uMsg){ case WM_NCCREATE: return TRUE; case WM_CREATE: cs = (LPCREATESTRUCT)lParam; printf("WindowProc called: %s\n",cs->lpCreateParams); return 0; case WM_DESTROY: PostQuitMessage(0); return 0; } return DefWindowProc(hWnd,uMsg,wParam,lParam); }

Не забываем экспортировать имя функции в глобальное пространство имен. Теперь список экспорта, определяемый в модуле WinApp.pm должен выглядеть следующим образом

our @EXPORT = qw( &_RegisterClass &_CreateWindow );

В файл test.pl добавим простой код тестирования функции _CreateWindow()

# Тестируем функцию создания окна my $HWND = _CreateWindow($className,'WinApp sample test', 0,100,100,200,200,'main::WndProc'); sleep(5);

Теперь можно скомпилировать проект и запустить тестовую программу с помощью команды

nmake test

Результат тестирования будет следующим

test.pl 1..2 ok 1 ok 2 WindowProc called: main::WndProc

Привязываем perl-обработчик к дескриптору окна

Каким образом передать имя perl-обработчика сообщений в функцию WindowProc() при создании окна мы выяснили. Но ведь по идее perl-обработчик должен вызываться каждый раз, когда окно получает сообщения. Как тут быть? Можно пойти на таран и завести на стороне C-кода глобальную переменную, которая будет хранить имя функции обработчика. Но в этом случае мы ограничиваем программу всего одним окном. Это не есть гут, скажете вы.

Не отчаивайтесь, мы выкручивались из ситуаций и посложнее, чем сохранение какого-то там строкового параметра. Ковыряясь в справочнике WinAPI, можно наткнуться на такую пару функций - GetWindowLong() и SetWindowLong(). На первый взгляд вся полезность этих функций заключается в установке и получении каких либо параметров окна. Однако, обратите внимание не маленькое упоминание о некоторой величине, которая ассоциируется с константой GWL_USERDATA. Эта константа позволяет связать с любым окном произвольное 32-х разрядную величину. Это вполне может быть и указатель. А имея возможность ассоциировать с окном указатель на произвольные данные, мы тем самым приобретаем возможность привязать к окну вообще любые значения, так как указать можно и на произвольную структуру данных. В общем, вот таким нехитрым способом мы привяжем строковое значение имени perl-функции к конкретному окну. Модуль получится гибким, красивым и умным

В нашем случае, привязку имени обработчика к окну нужно свести до уровня рефлекса модуля. Это значит, что легче всего возложить эту задачу на обработчик сообщения WM_CREATE, который у нас уже есть. Если вернуться к прототипу обработчика сообщений, то мы обнаружим наличие всех необходимых для привязки данных. Дескриптор создаваемого окна, который так нетерпеливо ожидает вызывающая CreateWindow() функция, поступает в обработчик в качестве первого аргумента. Вся прелесть в том, что на момент прихода сообщения WM_CREATE, в обработчик посылается действительный дескриптор - тот самый, который будет возвращен из функции CreateWindow().

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

LRESULT CALLBACK WindowProc(HWND hWnd, UINT uMsg,DWORD wParam,DWORD lParam) { LPCREATESTRUCT cs; LPSTR szFuncName; int NameLength; switch(uMsg){ case WM_NCCREATE: return TRUE; case WM_CREATE: cs = (LPCREATESTRUCT)lParam; NameLength = strlen(cs->lpCreateParams); if (NameLength <= 0) return -1; szFuncName = malloc(NameLength + 1); if (!szFuncName) return -1; strcpy(szFuncName,cs->lpCreateParams); SetWindowLong(hWnd,GWL_USERDATA, (DWORD)szFuncName); return 0; case WM_DESTROY: szFuncName = (LPSTR)GetWindowLong(hWnd,GWL_USERDATA); if (szFuncName) free(szFuncName); PostQuitMessage(0); return 0; } return DefWindowProc(hWnd,uMsg,wParam,lParam); }

Здесь код требует некоторых пояснений. Зачем - спросите вы - нам нужно создавать копию строки, ведь у нас уже есть строка? Дело в том, что указатель cs->lpCreateParams указывает на переменную с ограниченной областью видимости, иначе говоря - аналог переменной perl, объявленной с помощью my. Хорошо если в функцию _CreateWindow() передается значение глобальной переменной, но даже в этом случае, не зная всех тонкостей устройства perl, нельзя гарантировать что указатель будет верным после того, как функция _CreateWindow() завершит свою работу. Дабы не испытывать судьбу, мы динамически выделяем память для хранения имени. Как вы знаете, динамически-выделенная память существует до тех пор, пока её не освободят с помощью функции free() или же о ней позаботися (по крайней мере, должен) сборщик мусора при завершении программы. Таким образом, блок динамически выделенной памяти существует на всем протяжении жизни программы, что нас, в принципе, устраивает, так как время существования окна никогда не превышает время существования программы (логично, да?

В связи со всем вышеописанным, мы, как хорошие парни, обязательно должны освободить занятую память в тот момент, когда она нам больше не понадобится. Получение сообщения WM_DESTROY как раз подходящий момент. Заметьте, что я специально выделил пустыми строками те места, где по расчетам должнем вызываться per-обработчик. Для WM_CREATE, это происходит после всех необходимых шагов инициализации, кои у нас представлены процессом сопоставления дескриптору окна имени функции-обработчика на стороне perl. Для WM_DESTROY - наоборот, вызов должен производиться в начале, так как уничтожив связь между окном и обработчиком мы вообще теряем возможность что либо вызывать.

Еще хочу обратить ваше внимание на вызов функции PostQuitMessage(). Эта функция должна вызываться обязательно, так как она сигнализирует ситеме о том, что поток прекращает обрабатывать очередь сообщений. Если своевременно не сделать этого вызова, то цикл трансляции сообщений, который мы рассмотрим чуть позже, не завершится и программа зависнет.
Функции для работы с окнами

Мы написали кучу кода, а толку от модуля пока еще не видно. Мы даже ни разу не видели, как выглядит наше окно. Для того, чтобы иметь возможность как то управлять нашим окном, нам понадобятся несколько API-функций, которые я перечислил ранее. Сразу приведу их код из файла WinApp.xs

BOOL _ShowWindow(hWnd,nCmdShow) HWND hWnd; int nCmdShow; CODE: RETVAL = ShowWindow(hWnd,nCmdShow); OUTPUT: RETVAL BOOL _UpdateWindow(hWnd) HWND hWnd; CODE: RETVAL = UpdateWindow(hWnd); OUTPUT: RETVAL DWORD _SendMessage(hWnd,uMsg,wParam,lParam) HWND hWnd; DWORD uMsg; DWORD wParam; DWORD lParam; CODE: RETVAL = SendMessage(hWnd,uMsg,wParam,lParam); OUTPUT: RETVAL BOOL _PostMessage(hWnd,uMsg,wParam,lParam) HWND hWnd; DWORD uMsg; DWORD wParam; DWORD lParam; CODE: RETVAL = PostMessage(hWnd,uMsg,wParam,lParam); OUTPUT: RETVAL BOOL _DestroyWindow(hWnd) HWND hWnd; CODE: RETVAL = DestroyWindow(hWnd); OUTPUT: RETVAL

Весь этот код необходимо разместить в конце файла WinApp.xs. Как видим, ничего сложного с этими функциями не связано - просто передача параметров.
Обработка очереди сообщений

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

MSG msg; while (GetMessage(&msg, NULL, 0, 0)) { TranslateMessage(&msg); DispatchMessage(&msg); }

Структура MSG имеет следующее определение

typedef struct tagMSG { // msg HWND hwnd; UINT message; WPARAM wParam; LPARAM lParam; DWORD time; POINT pt; } MSG;

Из всех мемберов этой структуры нам сейчас должны быть неизвестны только два: time и pt. Согласно документации, time определяет время посылки сообщения, а pt - представляет собой координаты курсора в момент отправки сообщения. Вот так все просто. Хотя нам, судя по коду цикла обработки, даже и не обязательно знать, что там в этой структуре.

Мы без проблем можем написать XSUB-аналоги этих API-функций. Однако, здесь есть одна тонкость. Дело в том, что этот цикл работает со структурой, а в perl отсутствует понятие указателя. Мы, конечно, можем повозиться с pack/unpack или еще как-то решить эту проблему (например, по аналогии с именем обработчика, создать структуру динамически), однако на кой черт нам все это нужно. Цикл обработки практически одинаков для каждого окна (на самом деле, есть ситуации, когда цикл отличается, но это тема отдельной статьи), так почему бы нам не определить отдельную функцию, вызывая которую мы будем заставлять модуль автоматически обрабатывать очередь сообщений для нашего окна. Давайте так и поступим. Функцию назовем ProcMQ(), что означает - обработка очереди сообщений. Вот ее код в файле WinApp.xs

DWORD ProcMQ() INIT: MSG msg; CODE: while (GetMessage(&msg, NULL, 0, 0)) { TranslateMessage(&msg); DispatchMessage(&msg); } RETVAL = msg.wParam; OUTPUT: RETVAL

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

Мы подошли к самому сложному моменту расширения - обеспечить вызов обработчика, реализованного на стороне perl. Тут уже не обойтись без документации к XSUB-API. Так как мы очень ленивые (Ларри говорит, что это хорошо :), мы не будем сильно вникать - что и по-чем. Мы воспользуемся очень оригинальной методикой программирования Copy&Paste из наиболее подходящего примера. Этот самый пример я выудил из perlcall. Сэмпл под названием "Returning a Scalar" исчерпывающе поясняет как вызвать функцию, принимающую список и возвращающую скаляр. Нам это и надо, посему делаем Copy&Paste этого примера в файл WinApp.xs. Да, но копировать его нужно не в конец, а в начало файла (перед WindowProc(), иначе WindowProc() не увидит ее), так как по сути, это не будет функцией модуля WinApp, это просто вспомогательная функция для WindowProc().

После непродолжительны шаманских песнопений и пританцовываний вокруг этой функции с бубном, мы получаем примерно следующее:

static BOOL PerlCallback(hWnd,uMsg,wParam,lParam) HWND hWnd; DWORD uMsg; DWORD wParam; DWORD lParam; { int count; BOOL bResult; LPSTR szFuncName; dSP; szFuncName = (LPSTR)GetWindowLong(hWnd,GWL_USERDATA); if (!szFuncName) return FALSE; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newSVuv((UV)hWnd))); XPUSHs(sv_2mortal(newSVuv((UV)uMsg))); XPUSHs(sv_2mortal(newSVuv((UV)wParam))); XPUSHs(sv_2mortal(newSVuv((UV)lParam))); PUTBACK; count = call_pv(szFuncName,G_SCALAR); SPAGAIN; if (count != 1) croak("Big trouble\n") ; bResult = POPi; PUTBACK; FREETMPS; LEAVE; return bResult; }

Первым делом эта функция получает указатель на строку с именем функции perl, которую нужно вызвать для обработки сообщений. Обращаю ваше внимание на проверку, после вызова GetWindowLong(). Дело в том, что WM_CREATE не обязательно является первым сообщением. Однако алгоритм сопоставляет имя perl-обработчика только тогда, когда приходит сообщение WM_CREATE. Это означает, что если до того, как обработчик сообщений получит WM_CREATE система пошлет нам какое-нибудь другое сообщение, то PerlCallback() не сможет получить корректный указатель на строку. И если не выполнять этой проверки, то система сгенерирует экспекшн, так как будет произведена попытка обращения к неизвестно какой области памяти. Таким образом мы игнорируем все сообщения, которые приходят до WM_CREATE (поверьте, это небольшая потеря).

Теперь, наша задача сводится к присобачиванию вызова этой функции к обработчику WindowProc(). Вот как это выглядит на практике

LRESULT CALLBACK WindowProc(HWND hWnd, UINT uMsg,DWORD wParam,DWORD lParam) { LPCREATESTRUCT cs; LPSTR szFuncName; int NameLength; switch(uMsg){ case WM_NCCREATE: return TRUE; case WM_CREATE: cs = (LPCREATESTRUCT)lParam; NameLength = strlen(cs->lpCreateParams); if (NameLength <= 0) return -1; szFuncName = malloc(NameLength + 1); if (!szFuncName) return -1; strcpy(szFuncName,cs->lpCreateParams); SetWindowLong(hWnd,GWL_USERDATA, (DWORD)szFuncName); if (PerlCallback(hWnd,uMsg,wParam,lParam)) return 0; free(szFuncName); return -1; case WM_DESTROY: if (!PerlCallback(hWnd,uMsg,wParam,lParam)) return 1; szFuncName = (LPSTR)GetWindowLong(hWnd,GWL_USERDATA); if (szFuncName) free(szFuncName); PostQuitMessage(0); return 0; } return PerlCallback(hWnd,uMsg,wParam,lParam) ? 0 : DefWindowProc(hWnd,uMsg,wParam,lParam); }

Мы определяем WM_CREATE в качестве отправной точки для обработки сообщений на стороне perl. Это следует из описания функции PerlCallback(). Границей, завершающей процесс обработки сообщений, у нас является WM_DESTROY. После поступления этого сообщения, обработка очереди безоговорочно завершается посредством вызова PostQuitMessage().

В случае, когда мы получаем какой либо другое сообщение, мы ориентируемся на код возврата perl-обработчика для того, что бы определить - было ли обработано сообщение и нужно ли вызывать DefWindowProc(). Как я говорил ранее, вызов DefWindowProc() очень важен для необработанных сообщений. Ответственность за своевременный вызов ложится не только на WindowProc(), но и на обработчик на стороне perl. Очень важно, что бы perl-обработчик возвращал 0, в случае когда сообщение не обработано.
Поднимите мне веки или где наше окно?

Пора бы уже и полюбоваться на плоды трудов своих. Программа тестирования (файл test.pl) у меня выглядит следующим образом

# Тестируем функцию регистрации класса my $className = 'WinApp class'; my $style = 3; # CS_HREDRAW | CS_VREDRAW my $atom = _RegisterClass($className,$style); print $atom ? "" : "not ","ok 2\n"; # Тестируем функцию создания окна my $HWND = _CreateWindow($className,'WinApp sample test', 0,100,100,200,200,'main::WndProc'); _ShowWindow($HWND,1); _UpdateWindow($HWND); ProcMQ(); sub WndProc{ my ($hWnd,$uMsg,$wParam,$lParam) = @_; if ($uMsg == 1){ # WM_CREATE print "Window creation\n"; return 1; }elsif($uMsg == 2){ # WM_DESTROY print "Window destroying\n"; return 1; } return 0; # Это ОЧЕНЬ ВАЖНО!!! }

Да, господа, а вы не забыли подправить список экспорта в модуле WinApp.pm? Теперь он должен выглядеть так

our @EXPORT = qw( &_RegisterClass &_CreateWindow &_ShowWindow &_UpdateWindow &_SendMessage &_PostMessage &_DestroyWindow &ProcMQ );

После запуска программы, на экране появится самое обычное, ничем не примечательное окно. И ради этого мы столько пережили! - воскликнете вы. Ничего, дело за малым - определить константы и прочее, прочее. И.г. - навести марафет. А окно... Окно мы создавали вовсе не для того, что бы на него любоваться. Мы создавали его для того, что бы, как все нормальные программы, работать с системными сообщениями. Так сказать, альтернатива глюкавству сигналов в операционных системах Windows. Согласитесь, это ведь не очень удобно, когда из всех сигналов боль-менее пашет только INT, та и тот со своими заскоками. Так что, красота красотою, а правильно работать важнее.