Быстрая отрисовка

Вопросы программирования на Free Pascal, использования компилятора и утилит.

Модератор: Модераторы

Re: Быстрая отрисовка

Сообщение Pavia » 11.05.2018 14:33:46

Есть ещё один чит. Если увеличить число линий в 10 раз то мой код начинает обгонять canvas в 2 раза. :wink:
canvas 408 мс
LazyLine 205 мс
Вернее это canvas проседает в 2 раза.
Аватара пользователя
Pavia
постоялец
 
Сообщения: 210
Зарегистрирован: 07.01.2011 12:46:51

Re: Быстрая отрисовка

Сообщение Alex2013 » 11.05.2018 14:40:17

Pavia писал(а):Есть ещё один чит. Если увеличить число линий в 10 раз то мой код начинает обгонять canvas в 2 раза. :wink:
canvas 408 мс
LazyLine 205 мс
Вернее это canvas проседает в 2 раза.

АО МММ ! Круто короче.... :D

А ОGL побить в тесте Zub-а ? Как думаешь это вообще возможно ? :roll:

Зы
Кстати добавил чуть "испорченный" LazyLine в тест Зуба получил 714 ms
Код: Выделить всё
procedure LazyLine(BB:TBitmap; x1,y1,x2,y2:Integer); overload;
  var e,i,x,y,dx,dy,sx,sy:Integer;
   step:Integer;
  begin
  step:=0;
  if (BB=nil)then exit;
  if step=0 then
   begin
   x:=x1;
   y:=y1;
   dx:=Abs(x2-x1);
   dy:=Abs(y2-y1);
   sx:=Sign(x2-x1);
   sy:=Sign(y2-y1);

   if (dx=0) and (dy=0) then
    begin
    //Bmp.SetPixel
    SetPix(BB,x,y, clRed);
    Exit;
    end;
   if dy<dx then
    begin
    e:=2*dy-dx;
    i:=1;
    repeat
    SetPix(BB,x,y, clRed);
    while e>=0 do
     begin
     y:=y+sy;
     e:=e-2*dx;
     end;
    x:=x+sx;
    e:=e+2*dy;
    i:=i+1;
    until i>dx;
     SetPix(BB,x,y, clRed);
    end else
    begin
    e:=2*dx-dy;
    i:=1;
    repeat
     SetPix(BB,x,y, clRed);
     while e>=0 do
      begin
      x:=x+sx;
      e:=e-2*dy;
      end;
     y:=y+sy;
     e:=e+2*dx;
     i:=i+1;
     until i>dy;
    SetPix(BB,x,y, clRed);
    end;
   end;
  end;
   


Зы Зы
Переделал SetPix теперь работает без "сдвига по фазе" .
Код: Выделить всё
Procedure SetPix(Var BB:TBitmap;X,Y,C:Integer);
Type
TA=Array[0..1] of byte;
var
PA:^TA;
n:integer;
begin
if bb = NIL then exit;
if not InR(x,0,bb.Width-1) then exit;
if not InR(y,0,bb.Height-1) then exit;

//Bb.BeginUpdate; ;
pa:=bb.ScanLine[y];
N:=X*3;
pa^[n]  :=Blue(C);
pa^[n+1]:=Green(C);
pa^[n+2]:=red(C);
//Bb.EndUpdate;
end;
Последний раз редактировалось Alex2013 11.05.2018 15:09:54, всего редактировалось 1 раз.
Alex2013
энтузиаст
 
Сообщения: 864
Зарегистрирован: 03.04.2013 11:59:44

Re: Быстрая отрисовка

Сообщение Pavia » 11.05.2018 14:58:21

Alex2013 писал(а): Кстати добавил чуть "испорченный" LazyLine в тест Зуба получил 714 ms

Это Брезенхем. Суть LazyLine в том что он использует LazyBitmap там оптимизирован доступ к пикселям через софтварное кэширование указателей.
Побить OGL. Если настроить кэш проца, то можно ускорить в 8 раз. Плюс алгоритм быстрого брезенхема должен дать 1,1-2 раза и SSE ещё 1,1-2 раза. На малом окне приблизимся может и обгоним. А в полноэкранном там OGL рисует в несколько потоков.
Аватара пользователя
Pavia
постоялец
 
Сообщения: 210
Зарегистрирован: 07.01.2011 12:46:51

Re: Быстрая отрисовка

Сообщение Alex2013 » 11.05.2018 15:20:19

Про LazyBitmap я понял (но кода-то давно я с его помощью так красиво "уронил" ОС, что даже "экран смерти" КРАСНЫМ стал (это вообще как ?)... хотя это было еще на Лазаре 0.9ххх, а там и не такое бывало )
А потоки можно и через CPU гонять .
Alex2013
энтузиаст
 
Сообщения: 864
Зарегистрирован: 03.04.2013 11:59:44

Re: Быстрая отрисовка

Сообщение Pavia » 11.05.2018 16:22:26

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

С кэшем проца поигрался ускорение около 10%, а не в 8 раз. Так что догнать OGL не получится.
Аватара пользователя
Pavia
постоялец
 
Сообщения: 210
Зарегистрирован: 07.01.2011 12:46:51

Re: Быстрая отрисовка

Сообщение Alex2013 » 11.05.2018 18:41:13

О тогда поздравляю ! :idea: Работает стабильно .

Действительно перепутал с TLazIntfImage... :roll:
Да погонял тест на "старой кляче" .

Код: Выделить всё
OpenGL driver info: ATI Technologies Inc. AMD Radeon HD 6310 Graphics 4.2.11762 Compatibility Profile Context
Draw 10000 random lines
OpenGL....: 6 msec
Canvas....: 128 msec
Alex Byte.: 1381 msec
AGG.......: 4997 msec
GDIPlu....: 5082 msec

В принципе ожидемо:
Старый "полуофисный" нот HP635
Другой проц 2 ядра AMD E-300 память 4 гига видео (в ядре CPU ) аналог Radeon HD 6310
Проц слабее? Память медленне ( за то её чуть больше! )? Не сильно.
В OpenGL видео чуть быстрее.
В GDIPlus и AGG результаты почти одинаковы.

Зы
Муа-ха-ха! Из под Wine GDIPlus БЫСТРЕЕ ! :shock:

Draw 10000 random lines
Alex Byte : 1271msec
GDIPlus: 944msec
AGG: 4344msec
OpenGL: 44msec

Стоп ! Canvas: 39 msec :idea: Правда OpenGl в версии с канвас OpenGL: 28 msec ...

Тадам ! Рекорд !

OpenGL: 28 msec
Canvas: 32 msec
GDIPlus: 850 msec
AGG: 4378 msec
Alex2013
энтузиаст
 
Сообщения: 864
Зарегистрирован: 03.04.2013 11:59:44

Re: Быстрая отрисовка

Сообщение zub » 11.05.2018 23:29:59

Alex2013
Не занимайся ерундой. кому нужен вайн, а темболее гди+ через вайн. не выпилил бы гди - был бы нормальный тест в линуксе.
результаты с -O1
Код: Выделить всё
OpenGL driver info: NVIDIA Corporation GeForce GTX 680/PCIe/SSE2 4.6.0 NVIDIA 397.31
Draw 10000 random lines
Canvas: 61msec
Alex Byte : 177msec
Zub Byte : 47msec
OpenGL: 3msec

Код: Выделить всё
OpenGL driver info: NVIDIA Corporation GeForce GTX 680/PCIe/SSE2 4.6.0 NVIDIA 397.31
Draw 1000000 random lines
Canvas: 5711msec
Alex Byte : 17656msec
Zub Byte : 3341msec
OpenGL: 126msec

результаты с -O3
Код: Выделить всё
OpenGL driver info: NVIDIA Corporation GeForce GTX 680/PCIe/SSE2 4.6.0 NVIDIA 397.31
Draw 10000 random lines
Canvas: 60msec
Alex Byte : 178msec
Zub Byte : 36msec
OpenGL: 0msec

Код: Выделить всё
OpenGL driver info: NVIDIA Corporation GeForce GTX 680/PCIe/SSE2 4.6.0 NVIDIA 397.31
Draw 1000000 random lines
Canvas: 5396msec
Alex Byte : 17365msec
Zub Byte : 3293msec
OpenGL: 86msec

Твои кучи топиков про быстрое рисование были слиты первой попавшейся реализацией брезенхема взятой с какойто вики. + заменил вычисление пикселя через координаты на операции непосредственно с указателем. реализация колхозная донельзя и рости есть куда. Повод тебе задуматься. чуть позже дам результаты с кубунты на этойже машине

Добавлено спустя 12 минут 13 секунд:
kubuntu.
скомпилено под gtk2
Код: Выделить всё
OpenGL driver info: NVIDIA Corporation GeForce GTX 680/PCIe/SSE2 4.6.0 NVIDIA 390.48
Draw 10000 random lines
Canvas: 15msec
Alex Byte : 155msec
Zub Byte : 36msec
OpenGL: 1msec

под qt5 - реализации TOpenGLControl под этот виджесет нет, поэтому без него
Код: Выделить всё
OpenGL driver info:   
Draw 10000 random lines
Canvas: 15msec
Alex Byte : 166msec
Zub Byte : 32msec
Label4


Добавлено спустя 23 минуты 50 секунд:
High Sierra.
Cocoa
Код: Выделить всё
OpenGL driver info: NVIDIA Corporation NVIDIA GeForce GTX 680 OpenGL Engine 2.1 NVIDIA-10.30.25 355.11.10.10.30.120
Draw 10000 random lines
Canvas: 296msec
Alex Byte : 176msec
Zub Byte : 34msec
OpenGL: 6msec


Добавлено спустя 2 минуты 56 секунд:
В макосине канвас рисует алиаснутые линии почемуто. поэтому тормоз
У вас нет необходимых прав для просмотра вложений в этом сообщении.
zub
долгожитель
 
Сообщения: 2389
Зарегистрирован: 14.11.2005 23:51:26

Re: Быстрая отрисовка

Сообщение Alex2013 » 12.05.2018 00:32:00

zub писал(а):Твои кучи топиков про быстрое рисование были слиты первой попавшейся реализацией брезенхема взятой с какойто вики. + заменил вычисление пикселя через координаты на операции непосредственно с указателем. реализация колхозная донельзя и рости есть куда. Повод тебе задуматься. чуть позже дам результаты с кубунты на этойже машине


Можно подумать что я спорю ... Я самого начала говорил, что строить линии по точкам вообще в принципе ТОРМОЗ ...
А вот метод нашего уважаемого штатного "ЛогоЛаза" (В смысле Pavia :D ) стоит проверит в штатных условиях ... (То есть без обрезания его библиотеки ) плюс интересно что OpenCV покажет.
Так сейчас ухожу в Норию то бишь оффлайн "познавать истину"... «I'll be back» :wink: :idea:

Добавлено спустя 2 часа 51 минуту 57 секунд:
Поужинал отдохнул ... и давай снова программить ...
ИзображениеИзображение
Но результат так себе ... Правда мозги SetPix не много вправил .
Draw 10000 random lines
Canvas: 140 msec
Alex Byte : 525 msec
Zub Byte : 144 msec
OpenGL: 5 msec

:idea: LazyLine(с)Pavia - правда без его библиотеки выигрывает всего около 100 Msec

Код: Выделить всё
procedure TForm1.AlexBypePaint(Sender: TObject);
var
  i:integer;
  w,h:integer;
  LPTime:Tdatetime;
  tv1,tv2:GDBVertex;


// Только 24 Бита !
var BL:Integer;
Procedure SetPix(Var BB:TBitmap;X,Y,C:Integer);
Type
TA=Array[0..1] of byte;
var
PA:^TA;
n:integer;
begin
//Bb.BeginUpdate; ;
pa:=Pointer(BB.RawImage.Data+Y*BL);
N:=X*3;
pa^[n]  :=Blue(C);
pa^[n+1]:=Green(C);
pa^[n+2]:=red(C);
//Bb.EndUpdate;
end;

procedure LazyLine(BB:TBitmap; x1,y1,x2,y2:Integer); overload;
var e,i,x,y,dx,dy,sx,sy:Integer;
step:Integer;
begin
step:=0;
if (BB=nil)then exit;
if step=0 then
begin
x:=x1;
y:=y1;
dx:=Abs(x2-x1);
dy:=Abs(y2-y1);
sx:=Sign(x2-x1);
sy:=Sign(y2-y1);

if (dx=0) and (dy=0) then
  begin
  //Bmp.SetPixel
  SetPix(BB,x,y, clRed);
  Exit;
  end;
if dy<dx then
  begin
  e:=2*dy-dx;
  i:=1;
  repeat
  SetPix(BB,x,y, clRed);
  while e>=0 do
   begin
   y:=y+sy;
   e:=e-2*dx;
   end;
  x:=x+sx;
  e:=e+2*dy;
  i:=i+1;
  until i>dx;
   SetPix(BB,x,y, clRed);
  end else
  begin
  e:=2*dx-dy;
  i:=1;
  repeat
   SetPix(BB,x,y, clRed);
   while e>=0 do
    begin
    x:=x+sx;
    e:=e-2*dy;
    end;
   y:=y+sy;
   e:=e+2*dx;
   i:=i+1;
   until i>dy;
  SetPix(BB,x,y, clRed);
  end;
end;
end;

Const BB:TBitmap=nil;
  begin


     w:=TPanel(Sender).Width;
     h:=TPanel(Sender).Height;
     needtransform:=CheckBox1.Checked;
      BB:=TBitmap.Create;
      bb.PixelFormat:=pf24bit;
      bb.SetSize(w,h);
      BL:=BB.RawImage.Description.BitsPerLine div 8;
     LPTime:=now();

     Bb.BeginUpdate;
     for i:=1 to SpinEdit1.Value do
     begin
          tv1:=GetRandomVertex(w,h,w);
          tv2:=GetRandomVertex(w,h,w);
           LazyLine(BB,round(tv1.x),round(tv1.y),round(tv2.x),round(tv2.y));
     end;
  Bb.EndUpdate;
       TPanel(Sender).Canvas.Draw(0,0,bb);
     lptime:=now()-LPTime;
     bb.Free;
     Label2.Caption:='Alex Byte : '+inttostr(round(lptime*10e7))+'msec';
     processresult;
end;


Добавлено спустя 13 часов 10 минут 43 секунды:
Сделал OpenCV тест ... "Серебро" за ним ! :idea:
Код: Выделить всё
OpenGL driver info: ATI Technologies Inc. AMD Radeon HD 6310 Graphics 4.2.11762 Compatibility Profile Context
Draw 10000 random lines
OpenGL   : 7 msec
OpenCV   : 58 msec
Canvas   : 138 msec
Zub Byte : 142 msec


Alex Byte по прежнему около 500 msec
Пач кода...
Код: Выделить всё
uses
  Classes, gl,
  SysUtils, FileUtil, OpenGLContext, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, StdCtrls, Spin, Buttons, math,OpenCV,IPL;
//OpenCV,IPL можно взять из моей "трубы" + от туда-же opencv_core231.dll
...
procedure TForm1.AlexBypePaint(Sender: TObject);
...

Var
  cs: CvSize;
  cvCP1,cvCP2:cvPoint;
const
  frame: PIplImage=nil ;
  begin

     w:=TPanel(Sender).Width;
     h:=TPanel(Sender).Height;
     needtransform:=CheckBox1.Checked;
      BB:=TBitmap.Create;
      bb.PixelFormat:=pf24bit;
      bb.SetSize(w,h);
      BL:=BB.RawImage.Description.BitsPerLine div 8;
If not CheckBox2.Checked then begin

  // тут тоже что и было  раньше...

      end else begin
//*******************************************************
//*              Подключение Опен ЦВ              *
//*******************************************************

Cs.width:=w;
Cs.height:=h;

if Frame = nil then  Frame:= cvCreateImage( cs, 8, 3 );
FillChar(Frame^.ImageData^, Frame^.ImageSize,0);// Как вытесняется чистить все-же полезно
// иначе непонятно что получается при изменении количества линий     
LPTime:=now();
for i:=1 to SpinEdit1.Value do
begin
     tv1:=GetRandomVertex(w,h,w);
     tv2:=GetRandomVertex(w,h,w);
//DrawLine
cvCP1.x:=round(tv1.x); cvCP1.y:=round(tv1.y);
cvCP2.x:=round(tv2.x); cvCP2.y:=round(tv2.y);
cvLine(Frame, cvCP1, cvCP2, CV_RGB(0, 255, 0));
end;
   IplImage2Bitmap(Frame,BB);
   lptime:=now()-LPTime;
   // Иначе было бы не честно по отношению к  OpenCV
   // в чистом OpenCV была бы одна пересылка
   // Но разница всего менее  10 msec (на HP635)
   TPanel(Sender).Canvas.Draw(0,0,bb);
  end;
     bb.Free;
  If not CheckBox2.Checked then
  Label2.Caption:='Alex Byte : '+inttostr(round(lptime*10e7))+'msec'
  Else Label2.Caption:='OpenCV : '+inttostr(round(lptime*10e7))+'msec';
     processresult;
end;


Добавить галку "OpenCV " (CheckBox2 ) и все...

ИзображениеИзображение

Но стоит поставить 100 000 линий и OpenGL снова недосягаем.... :idea:
Alex2013
энтузиаст
 
Сообщения: 864
Зарегистрирован: 03.04.2013 11:59:44

Re: Быстрая отрисовка

Сообщение Alex2013 » 14.05.2018 02:29:40

В общем вот полный набор на тешущий момент ... Исходник + бинарник + DLL (32 бита для большей совместимости )
:arrow: gditestforalex_OCV.7z :idea:

Интересно за счет чего рисовалка линий в OpenCV быстрее почти на порядок ? :idea:
Alex2013
энтузиаст
 
Сообщения: 864
Зарегистрирован: 03.04.2013 11:59:44

Re: Быстрая отрисовка

Сообщение Pavia » 14.05.2018 10:48:52

Alex2013
У меня ком по шустрее будет увеличил число линий в 10 раз.
Во весь экран
OpenGL driver info: ATI Technologies Inc. AMD Radeon HD 7800 Series 4.4.13285 Compatibility Profile Context 14.502.1002.0
Draw 100000 random lines
Alex Byte : 1249msec
Zub Byte : 522msec
Lazy : 421msec
OpenCV : 287msec
Canvas: 176msec
OpenGL: 6msec

Малый формат изображения
OpenGL driver info: ATI Technologies Inc. AMD Radeon HD 7800 Series 4.4.13285 Compatibility Profile Context 14.502.1002.0
Draw 100000 random lines
Alex Byte : 528msec
Zub Byte : 174msec
Lazy : 133msec
Canvas: 125msec
OpenCV : 73msec
OpenGL: 7msec

---------------------------
Поправил OpenCV пару строк. Там картинка не пересоздавалась.
Добавил свою библиотеку.
У Zub был выход за приделы массива, добавил выравнивание.
:arrow: gditestforalex_OCV.7z
Аватара пользователя
Pavia
постоялец
 
Сообщения: 210
Зарегистрирован: 07.01.2011 12:46:51

Re: Быстрая отрисовка

Сообщение Mavlyudov » 14.05.2018 12:40:42

Есть ли OpenGLContext для делфи? или что можно вместо него исопльзовать?(не могу откомпилировтаь gditestforalex_OCV)

Вот через OpenGL отриовка точки. Но больно много дополнительных парметров кроме самой процедуры WritePoint.
Можно как-то сократить?

Код: Выделить всё
var
  Form1: TForm1;
  dc:hdc;
  hrc:HGLRC;

implementation

{$R *.dfm}
procedure SetDCPixelFormat (hdc : HDC);
var
pfd : TPixelFormatDescriptor;
nPixelFormat : Integer;
begin
FillChar(pfd, SizeOf (pfd), 0);
pfd.dwFlags :=PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
nPixelFormat :=ChoosePixelFormat (hdc, @pfd);
SetPixelFormat(hdc, nPixelFormat, @pfd);
end;

procedure MakeDC(DC:HWND);
begin
SetDCPixelFormat(DC);
hrc := wglCreateContext(DC);
wglMakeCurrent(DC, hrc);
//glClearColor (0.0, 0.0, 0.75, 1.0);
glMatrixMode (GL_PROJECTION);
//glLoadIdentity;
glFrustum (-1, 1, -1, 1, 2, 20);
glMatrixMode (GL_MODELVIEW);
//glLoadIdentity;
glTranslatef(0.0, 0.0, -6.0);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
DC:=GetDC(Handle);
MakeDC(DC);
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
wglMakeCurrent(0, 0);
wglDeleteContext(hrc);
ReleaseDC(Handle, DC);
DeleteDC(DC);
end;

procedure WritePoint(DC:HDC; x,y:integer;ic:TColorREF);
var
r,g,b:DWORD;
begin
r:=GetRValue(ic);
g:=GetGValue(ic);
b:=GetBValue(ic);
glPointSize(1);
glColor3f(r,g,b);
glBegin(GL_POINTS);
glVertex2f(x,y);
glEnd;
end;


procedure TForm1.FormPaint(Sender: TObject);
begin
WritePoint(DC,1,1,clyellow);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SwapBuffers(DC);
end;


Еще вопрос: Координаты x,y для отрисовки точки - это же не координаты пиксела? ставлю WritePoint(DC,1,1,clyellow); рисует непонятно где (где-то справа)? Как сопоставить с координатами на форме?
Mavlyudov
новенький
 
Сообщения: 20
Зарегистрирован: 24.01.2010 20:35:23

Re: Быстрая отрисовка

Сообщение zub » 14.05.2018 12:59:56

Mavlyudov
В инете куча учебников по опенгл. возмите какойнить постарее, чтоб без шейдеров, но с матрицами.
Почитайте и приходите с вопросами
zub
долгожитель
 
Сообщения: 2389
Зарегистрирован: 14.11.2005 23:51:26

Re: Быстрая отрисовка

Сообщение Pavia » 14.05.2018 15:55:52

Есть ли OpenGLContext для делфи? или что можно вместо него исопльзовать?(не могу откомпилировтаь gditestforalex_OCV)

Нету. GLScene. (у gditestforalex_OCV много кода рассчитанного на LCL его надо будет править под VCL)

Mavlyudov писал(а):Можно как-то сократить?
это глупый вопрос. Можно использовать glut, GLScene, в конце концов вынести всё что мешает в отдельный модуль.
Mavlyudov писал(а):Еще вопрос: Координаты x,y для отрисовки точки - это же не координаты пиксела? ставлю WritePoint(DC,1,1,clyellow); рисует непонятно где (где-то справа)? Как сопоставить с координатами на форме?

Это делается двумя функциями glViewport и glOrtho.
glFrustum следует заменить на glOrtho. И выучит уроки по OpenGL и матрицам.
Аватара пользователя
Pavia
постоялец
 
Сообщения: 210
Зарегистрирован: 07.01.2011 12:46:51

Re: Быстрая отрисовка

Сообщение Alex2013 » 14.05.2018 16:47:45

:idea:
Pavia писал(а):Поправил OpenCV пару строк. Там картинка не пересоздавалась.
Добавил свою библиотеку.
У Zub был выход за приделы массива, добавил выравнивание.
gditestforalex_OCV.7z


Антивирус ругается .... Trojan:Win32/Spursint.F!cl :idea: :roll:
Alex2013
энтузиаст
 
Сообщения: 864
Зарегистрирован: 03.04.2013 11:59:44

Re: Быстрая отрисовка

Сообщение Pavia » 14.05.2018 17:48:01

Alex2013
Спасибо за бдительность
Alex2013 писал(а):Антивирус ругается .... Trojan:Win32/Spursint.F!cl

https://www.virustotal.com/ru/file/e5d4 ... 526302430/
https://www.virustotal.com/ru/file/c283 ... 526302279/
Думаю ложные срабатывания. У меня антивирус молчит.

:arrow: https://bitbucket.org/Pavia00/gditest/src/master/
:idea: ПС. Осваеваем джит.
Аватара пользователя
Pavia
постоялец
 
Сообщения: 210
Зарегистрирован: 07.01.2011 12:46:51

Пред.След.

Вернуться в Free Pascal Compiler

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2

Рейтинг@Mail.ru
cron