Помощь - Поиск - Пользователи - Календарь
Полная версия: Арифметика указателей
Форум «Всё о Паскале» > Современный Паскаль и другие языки > Ада и другие языки
TarasBer
Я не понял, как именно надо использовать пакет System.Storage_Elements
Итак, задача такая, у меня есть тип

type TColor is new Interfaces.Unsigned_32;
type AColor is access all TColor;

type TBitmap is new Controlled with record
Handle : HBITMAP;
DC : HDC;
Mem : aliased AColor; -- или удобнее aliased PVOID?
SizeX, SizeY, Depth : integer;
end record;


У него есть метод:

function Get_Pixel(B: TBitmap; X, Y: integer) return AColor;
-- возвращает указатель на пиксел с данными координатами
pragma Inline(Get_Pixel);

function Get_Pixel(B: TBitmap; X, Y: integer) return AColor is
begin
Assert((X >= 0) and (X < B.SizeX) and (Y >= 0) and (Y < B.SizeY));
return B.Mem + X + Y * B.SizeX;
end;



Последняя функция не компилируется. Что надо сделать, чтобы она скомпилировалась?
Кстати, здесь мне очень важна скорость, с точностью до лишних тактов и копирований чисел туда-сюда.
volvo
Как память выделяется под TBitmap.Mem, можно посмотреть? По-моему, ты избрал неправильный путь...
TarasBer
> Как память выделяется под TBitmap.Mem, можно посмотреть?


procedure Set_Size(B: in out TBitmap; X, Y, D: integer) is
BI: aliased BitmapInfo;
ScreenDC: HDC;
i: INT;
o: HGDIOBJ;
p: PVOID;

type aaColor is access all aColor;
type PPVoid is access all PVOID;

function To_PVOID is new Ada.Unchecked_Conversion(PBitmapInfo, PVOID);
function To_PPVOID is new Ada.Unchecked_Conversion(aaColor, PPVOID);
begin
Finalize(B);

p := MemSet(To_PVOID(BI'Unchecked_Access), 0, BI'Size / 8);

BI.bmiHeader.biSize := BI.bmiHeader'Size / 8;
BI.bmiHeader.biWidth := LONG(X);
BI.bmiHeader.biHeight := LONG(Y);
BI.bmiHeader.biPlanes := 1;
BI.bmiHeader.biBitCount := USHORT(D);

ScreenDC := GetDC(System.Null_Address);
B.DC := CreateCompatibleDC(ScreenDC);
B.SizeX := X;
B.SizeY := Y;
B.Depth := D;
B.Handle := CreateDIBSection( B.DC, BI'Unchecked_Access, DIB_RGB_COLORS, To_PPVOID(B.Mem'Access), System.Null_Address, 0);
o := SelectObject(B.DC, B.Handle);
i := ReleaseDC(System.Null_Address, ScreenDC);
end;



> По-моему, ты избрал неправильный путь...

Хочешь сказать, что раз у меня есть DC, то я могу использовать стандартные библиотеки? Нестандартные графические вещи мне тоже нужны.
volvo
А, то есть, ты не сам выделяешь место под этот массив, а это делает сторонняя API-шная процедура? Тогда надо проверять. Или сегодня поздно вечером, или завтра (когда буду под Windows), попробую пошаманить... Я думал, ты выделяешь сам, тогда я бы описывал тип так:
   type AColor_Array is array (Natural range <>) of aliased AColor;
type TBitmap is new Controlled with record
Handle : HBITMAP;
DC : HDC;
SizeX, SizeY, Depth : integer;

Mem : AColor_Array (0 .. Win32.ANYSIZE_ARRAY);
end record;
, а если выделяет CreateDIBSection - это надо смотреть, как оно описано, и что оно делает, может быть, можно и так сделать, как я выше показал, а может и нельзя, надо экспериментировать.
-TarasBer-
> тогда я бы описывал тип так:

А инициализировать как?
Чтобы DC был связан именно с этим участком памяти. Чтобы можно было использовать как ГДИ, так и прямое обращение к пикселам.
volvo
Так... До винды я так и не добрался, но фиг бы с ним. Насколько я помню, CreateDIBSection своим четвертым параметром возвращает указатель на массив пикселей (а не на массив указателей на пиксели). Тогда что-то в таком роде попробуй:

   type TColor is new Interfaces.Unsigned_32;

type TColor_Array is array (Integer range 0 .. Win32.ANYSIZE_ARRAY) of aliased TColor;
type PTColor_Array is access all TColor_Array;

type TBitmap is new Controlled with record
Handle : HBITMAP;
DC : HDC;
SizeX, SizeY, Depth : integer;

Mem : aliased Win32.PVOID;
end record;

function Get_Pixel(B: TBitmap; X, Y: integer) return TColor;
-- возвращает САМ ПИКСЕЛ с данными координатами
pragma Inline(Get_Pixel);


-- Вызов CreateDIBSection будет проходить так:

pBuffer : aliased PVOID;
-- ...
B.Handle := Win32.Wingdi.CreateDIBSection (B.DC, BI'Unchecked_Access,
DIB_RGB_COLORS, pBuffer'Access,
System.Null_Address, 0);
B.Mem := pBuffer;

-- , а сама реализация GetPixel - проста до безобразия:

function Get_Pixel(B: TBitmap; X, Y: integer) return TColor is
function To_PTColorArray is new Ada.Unchecked_Conversion (Win32.PVOID, PTColor_Array);
Ptr : constant PTColor_Array := To_PTColorArray (B.Mem);
begin
pragma Assert((X >= 0) and (X < B.SizeX) and (Y >= 0) and (Y < B.SizeY));

return Ptr.all(X + Y * B.SizeX);
end;
-TarasBer-
> Насколько я помню, CreateDIBSection своим четвертым параметром возвращает указатель на массив пикселей (а не на массив указателей на пиксели).

Да, поэтому надо указатель на пиксел передать по указателю. Двойной указатель получается. out-параметры в функциях, ага.

> function To_PTColorArray is new Ada.Unchecked_Conversion (Win32.PVOID, PTColor_Array);

Это же скомпилится в перекидывание из регистра в регистр, что при оптимизации вообще изчезнет, я так понимаю?
И если возвращать сам пиксел, то тогда и отдельно надо писать процедуру установки цвета, а тогда

SetPixel(((GetPixel(x, y) and $FEFEFE) + (Txr and $FEFEFE)) shr 1)


приведёт к тому, что адрес будет считаться дважды, вместо

P := GetPixelAddr(x, y);
P^ := (((P^ and $FEFEFE) + (Txr and $FEFEFE)) shr 1);


А брать указатели на элементы массива в Аде нельзя, я так понял.

Вообще, типичный пример цикла, ради которого я всё это обсуждаю:

PX := PColor(PChar(PY) + i1 shl 2);
for i := i1 to i2 do begin
PX^ := PColor(PChar(Txr.Mem) + ((tx shr 16) + (ty shr 16) shl Txr.OrdX) shl 2)^;
inc(PX);
inc(tx, dtx);
int(ty, dty);
end;
Inc(PY, Buf.SizeY);


Оптимизация очень важна тут. На Д7, к сожалению, много обращений к вершине стека, по регистрам хреново разруливает, правда, скорость меня устраивает в режиме 800х600 на селероне 600МГЦ.
Да, я знаю, что умные дяди в таких случаях используют ОткрытыйГЛ и ПрямойХ, но тёплый ламповый софтрендер всё равно выглядит по другому и узнаваемо, для меня это важно.
volvo
Ну, тогда работай с непрерывным массивом данных (или как он называется, я о flat array). Больше ничего тебе предложить не могу. Пойми: Ада создавалась для безопасного решения задач, а ты всеми путями пытаешься сделать работу как можно более опасной. В идеале я бы запрещал даже использование того блока памяти, который был выделен CreateDIBSection, любыми НЕ WinAPI-шными функциями, негоже руками туда лазить. Мало ли. Вот работает оно, работает, "потом бац, вторая смена" (С), в смысле, MS взяла и изменила формат. Безопасно? Ни в коем случае. Зато быстро. Нужна скорость в ущерб безопасности - тебе в сторону С. Из Ады наоборот убирают адресную арифметику (в Ada 83 она была, в 95 тоже, хотя и в более урезанном виде, в 2005 ее почти нет), ибо это непереносимо, и в общем случае будет работать только у тебя на машине, на другом процессоре или на другой версии ОС работоспособность не гарантируется, могут быть другие размеры, другие выравнивания, и т.д. Ты пробовал свои программы запускать на 64-битных ОСях? На WinXP x64 Edition, например? Я уж не спрашиваю про Win7...

Если интересно, как организовать flat array - то вот так:

   Max_X : constant Integer := 1024;  -- какие-то значения, заведомо бОльшие
Max_Y : constant Integer := 1024; -- чем максимальный размер секции.
procedure Do_It (B : TBitmap) is
type Flat_Type is array(1 .. Max_X * Max_Y) of TColor;
Flat_Array : Flat_Type;
for Flat_Array'Address use B.Mem; -- Absolute, ага...
begin
-- ... А тут тебе карт-бланш, работай с массивом по индексу, как тебе угодно
-- только следи за границами, а то такого натворить можно...
end Do_It;
TarasBer
> В идеале я бы запрещал даже использование того блока памяти, который был выделен CreateDIBSection, любыми НЕ WinAPI-шными функциями, негоже руками туда лазить.

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

> Нужна скорость в ущерб безопасности - тебе в сторону С.

Да, нужна. Си не нужен, там опасные вещи можно натворить совершенно случайно. Нужна осознанная возможность делать некоторые операции. Пусть даже для этого надо написать что-то типа Pragma Unsafe(GetPixel).

> Ты пробовал свои программы запускать на 64-битных ОСях? На WinXP x64 Edition, например? Я уж не спрашиваю про Win7...

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

> -- только следи за границами, а то такого натворить можно...

Я очень слежу, модуль для графики я отлаживал долго. Да, в нём всего пара функций, но он работает стабильно, в левые адреса не лезет. Народ мою игру тестировал, много человек, в конкурсной версии багов не нашли, хотя там велосипедом был почти весь код.
volvo
Ну, раз за границами следишь - вот тебе еще информация к размышлению:

with System; use System;
with System.Storage_Elements;
with System.Address_To_Access_Conversions;
with Interfaces; use Interfaces;

with Ada.Text_IO;

procedure Main is

type my_rec is record
R, G, B : Interfaces.Unsigned_8;
end record;
my_arr : array(1 .. 10) of aliased my_rec := (others => (others => 0));

package RecPtr is new System.Address_To_Access_Conversions (My_Rec);
PArr : RecPtr.Object_Pointer;

subtype Offset is System.Storage_Elements.Storage_Offset;
function "+" (A : System.Address; I : Offset ) return Address
renames System.Storage_Elements."+";

begin
for i in my_arr'Range loop
Ada.Text_IO.Put_Line(
Unsigned_8'Image(my_arr(i).R) & " " &
Unsigned_8'Image(my_arr(i).G) & " " &
Unsigned_8'Image(my_arr(i).B) & " "
);
end loop;

PArr := my_arr(1)'Unchecked_Access;
for i in my_arr'Range loop
parr.all.R := parr.all.R + 10;
parr := RecPtr.To_Pointer(RecPtr.To_Address(PArr) + 3); -- Обе эти функции - Intrinsic
end loop;

for i in my_arr'Range loop
Ada.Text_IO.Put_Line(
Unsigned_8'Image(my_arr(i).R) & " " &
Unsigned_8'Image(my_arr(i).G) & " " &
Unsigned_8'Image(my_arr(i).B) & " "
);
end loop;
end Main;
После запуска, как и ожидалось:

 0  0  0 
0 0 0
0 0 0
0 0 0
0 0 0
0 0 0
0 0 0
0 0 0
0 0 0
0 0 0
10 0 0
10 0 0
10 0 0
10 0 0
10 0 0
10 0 0
10 0 0
10 0 0
10 0 0
10 0 0

, но с такими вещами надо обращаться очень аккуратно...
TarasBer
> array(1 .. 10) of aliased

Странно, почему у меня это раньше не получалось... Какая-то ошибка выдавалась, что нельзя сюда aliased писать.

Насколько я понял из примера, элементы массива идут в памяти подряд, без выравнивания на 4 байта, странно.
volvo
А, да. Я забыл про это упомянуть. Выравнивания - они от ОС зависят. У меня сейчас = 1 по умолчанию. Если у тебя будет больше, или сам выставишь, скажем:

   type my_rec is record
R, G, B : Interfaces.Unsigned_16;
end record;
for my_rec'alignment use 4;
, то естественно, надо пересчитывать смещения по-другому:

   SizeR : constant Integer := Unsigned_16'Size;
SizeG : constant Integer := Unsigned_16'Size;
SizeB : constant Integer := Unsigned_16'Size;

D : constant integer := My_Rec'Alignment *
(((SizeR + SizeG + SizeB) / Storage_Unit + My_Rec'Alignment - 1) / My_Rec'Alignment);
-- ...

parr := RecPtr.To_Pointer(RecPtr.To_Address(PArr) + Offset(D));
, теперь это будет правильно работать при любом выравнивании.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.