Арифметика указателей, АДА Опции

[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));

, теперь это будет правильно работать при любом выравнивании.