Возможно, что вам приходилось когда-нибудь писать код создания окна на чистом WinApi. Наверно, он выглядел примерно так:
function CreateWindow(Width, Height : Integer; Fullscreen : Boolean; PixelDepth : Integer) : Boolean;
// ...
begin
// ...
if (RegisterClass(wndClass) = 0) then // Attemp to register the window class
begin
MessageBox(0, 'Failed to register the window class!', 'Error', MB_OK or MB_ICONERROR);
Exit
end;
// ...
h_Wnd := CreateWindowEx(dwExStyle, // Extended window styles
'OpenGL', // Class name
WND_TITLE, // Window title (caption)
dwStyle, // Window styles
0, 0, // Window position
Width, Height, // Size of window
0, // No parent window
0, // No menu
h_Instance, // Instance
nil); // Pass nothing to WM_CREATE
if h_Wnd = 0 then
begin
MessageBox(0, 'Unable to create window!', 'Error', MB_OK or MB_ICONERROR);
Exit;
end;
// Try to get a device context
h_DC := GetDC(h_Wnd);
if (h_DC = 0) then
begin
MessageBox(0, 'Unable to get a device context!', 'Error', MB_OK or MB_ICONERROR);
Exit;
end;
// ...
PixelFormat := ChoosePixelFormat(h_DC, @pfd);
if (PixelFormat = 0) then
begin
MessageBox(0, 'Unable to find a suitable pixel format', 'Error', MB_OK or MB_ICONERROR);
Exit;
end;
if (not SetPixelFormat(h_DC, PixelFormat, @pfd)) then
begin
MessageBox(0, 'Unable to set the pixel format', 'Error', MB_OK or MB_ICONERROR);
Exit;
end;
// Create a OpenGL rendering context
h_RC := wglCreateContext(h_DC);
if (h_RC = 0) then
begin
MessageBox(0, 'Unable to create an OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
Exit;
end;
if not wglMakeCurrent(h_DC, h_RC) then
begin
MessageBox(0, 'Unable to activate OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
Exit;
end;
// ...
Result := True;
end;
Можно заметить, что тут очень много копипастится код
MessageBox(0, 'Unable to «что не получилось»!', 'Error', MB_OK or MB_ICONERROR);
Exit;
Кроме копипаста этих двух строк, есть и второй копипаст: вместо «что не получилось» нужно везде прописывать название функции, в которой это не получилось. Как это можно бы было улучшить? Вынести в отдельную функцию нельзя, потому что Exit не умеет прыгать сразу на две функции вверх, а чтобы message box отобразил строку, нужно эту строку вбить вручную (не важно где, главное что эта строка должна быть вбита своими руками).
Конечно, в языке есть исключения, но WinApi не бросает никаких исключений специально для Free Pascal в случае штатных ошибок.
Как же быть? А никак — только копипаст. Те же беды с контролем ошибок в WinSock, DirectX и далее по списку.
Как такое обойти на лиспе? Понятно, что в данном случае нужно писать макрос, который принимает последовательность команд и генерирует из них код, который последовательно их выполняет, проверяя возвращаемые значения, и в случае нулевого результата, выдаёт мессадж-бокс с последующим возвращением NIL.
(defmacro block-check-winapi (&body body)
`(block NIL
,@(loop for f in body collect
`(if (eql ,f 0)
(progn
(MessageBox 0
(format NIL "Unable to ~a" ',f)
"Error"
(or MB_OK MB_ICONERROR))
(return NIL))))
T))
Как всегда, для наглядности привожу пример того, во что эта конструкция разворачивается:
(block-check-winapi
(RegisterClass wndClass)
(CreateWindowEx dwExStyle
"OpenGL"
WND_TITLE
dwStyle
0 0
Width
Height
0
0
h_Instance
NIL))
(BLOCK NIL
(IF (EQL (REGISTERCLASS WNDCLASS) 0)
(PROGN
(MESSAGEBOX 0 (FORMAT NIL "Unable to ~a" '(REGISTERCLASS WNDCLASS))
"Error" (OR MB_OK MB_ICONERROR))
(RETURN NIL)))
(IF (EQL
(CREATEWINDOWEX DWEXSTYLE "OpenGL" WND_TITLE DWSTYLE 0 0 WIDTH HEIGHT 0
0 H_INSTANCE NIL)
0)
(PROGN
(MESSAGEBOX 0
(FORMAT NIL "Unable to ~a"
'(CREATEWINDOWEX DWEXSTYLE "OpenGL" WND_TITLE DWSTYLE 0 0 WIDTH
HEIGHT 0 0 H_INSTANCE NIL))
"Error" (OR MB_OK MB_ICONERROR))
(RETURN NIL)))
T)
Читать дальше......
