OpenGL и Стереопара + Использование данных Трекинга в VR

Вопросы программирования и использования среды Lazarus.

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

Re: OpenGL и Стереопара + Использование данных Трекинга в VR

Сообщение Alex2013 » 12.02.2021 21:54:26

Pavia писал(а):Код надо смотреть.

Код уже переделал там текстура вверх ногами была ..
Но вернуть обратно несложно.
Код: Выделить всё
glPushMatrix();
glTranslatef(0,1.5,0);
glScalef(0.5,0.5,0.5);
glRotatef( BaseA*100, 0,1.0, 0);
glRotatef(90,1.0,0.0,0.0);
OGL_DrawLoad3e(2,2.8,1);  //!!! Внешняя модель
glPopMatrix();

glPushMatrix();
glTranslatef(-2,1.5,-1);
glRotatef(BaseA*100,1.0,0.0,0.0);
glCallList(MM1);
glPopMatrix();

glPushMatrix();
glTranslatef(0.5,1.8,-7.5);
//glRotatef(180,1.0,0.0,0.0); .// при повороте   glTranslatef(0.5,1.8,1.0);
AAA1(Texture1);
glPopMatrix();


Сейчас все немного сдвинуто но в принципе довольно похоже на то что было ..
Код: Выделить всё
  procedure AAA1( Tex : integer);
  begin
   glEnable(GL_TEXTURE_2D);
    glBindTexture(GL_TEXTURE_2D, Tex);
    glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
    glBegin(GL_QUADS);
    glTexCoord2f(0, 1);  glVertex3f( -4.0,  2.0,  2.0); // 1
    glTexCoord2f(0, 0);  glVertex3f( -4.0, -2.0,  2.0); // 2
    glTexCoord2f(1, 0);  glVertex3f(  4.0, -2.0,  2.0); // 3
    glTexCoord2f(1, 1);  glVertex3f(  4.0,  2.0,  2.0); // 4
    glEnd();
  glDisable(GL_TEXTURE_2D);
  end;

Вообщем не страшно! Я было подумал, что это что-то общее для всех текстурированных объектов ... но если нет то вероятно я просто где-то ошибся .
Alex2013
долгожитель
 
Сообщения: 2924
Зарегистрирован: 03.04.2013 11:59:44

Re: OpenGL и Стереопара + Использование данных Трекинга в VR

Сообщение Alex2013 » 14.02.2021 09:46:14

"Новая сказка о старом ".. :wink:
Попробовал я юзать стерео картинки вместо обычной текстуры
То что текстуры "плющет" по RGВ понятно "плавали знаем"(пока просто "перевернул" цвета в самых текстурах ) . Но то что SDL отказывается загружать любые картинки кроме созданных в GIMP новость. (пробовал форматы TGA и JPG ) GIMP у меня есть, но какого черта? :idea:
Зы
Кстати почему не получается "перевернуть цвета" через gluBuild2DMipmaps (GL_TEXTURE_2D, GL_BGR, ... ( вместо GL_RGB )
Код работает но текстуры не показывает .
Alex2013
долгожитель
 
Сообщения: 2924
Зарегистрирован: 03.04.2013 11:59:44

Re: OpenGL и Стереопара + Использование данных Трекинга в VR

Сообщение Seenkao » 14.02.2021 16:15:53

Alex2013 писал(а):Кстати почему не получается "перевернуть цвета" через gluBuild2DMipmaps (GL_TEXTURE_2D, GL_BGR, ... ( вместо GL_RGB )

потому что это не "переворачивание", это указание, в каком формате поданы цвета процедуре.
"Переворачивать" должен ты их сам.
Seenkao
энтузиаст
 
Сообщения: 502
Зарегистрирован: 01.04.2020 03:37:12

Re: OpenGL и Стереопара + Использование данных Трекинга в VR

Сообщение Alex2013 » 15.02.2021 01:56:37

Seenkao писал(а):
Alex2013 писал(а):Кстати почему не получается "перевернуть цвета" через gluBuild2DMipmaps (GL_TEXTURE_2D, GL_BGR, ... ( вместо GL_RGB )

потому что это не "переворачивание", это указание, в каком формате поданы цвета процедуре.
"Переворачивать" должен ты их сам.

Я так и сделал .... (причем заранее а не в процессе загрузки ).
Зы
Сейчас новый приколы ! При создании части сцены решил использовать понравившийся мне GlList и УПС! "Живьем показывает", а записать в "макрос" не поучается . ( А жаль, там у меня добряче проц напрягает )

"Куб боргов и страна чудес " :idea:
ИзображениеИзображение
Alex2013
долгожитель
 
Сообщения: 2924
Зарегистрирован: 03.04.2013 11:59:44

Re: OpenGL и Стереопара + Использование данных Трекинга в VR

Сообщение Alex2013 » 19.02.2021 05:47:24

Сегодня возился с выбором объектов мышкой ... Перепробовал кучу вариантов, но сработал самый древний .... :D

Изображение
Вытащил код чуть-ли не из времен первого дельфи... ( бедный Карл не пережил собственных похорон... :wink: ) немного подправил все заработало в новой версии Лазаруса под 64-бита и на OpenGLContext .
Код: Выделить всё
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    ExtCtrls, StdCtrls, Buttons, OpenGLContext,Gl,Glu,GlExt;
type
  { TForm1 }
  TForm1 = class(TForm)
    Memo1: TMemo;
    OpenGLControl1: TOpenGLControl;
    Panel1: TPanel;
    Timer1: TTimer;


    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Init_gl;
    procedure OpenGLControl1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure OpenGLControl1Resize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    function DoSelect(x : GLint; y : GLint) : GLUInt;
    procedure Render (mode : GLEnum);
  private
  public
  end;
var
  Form1: TForm1;
  Angle : GLfloat = 0;
  time : LongInt;

  wrkX, wrkY : Array [0..5] of Single;
    vp : Array [0..3] of GLint;
    selectBuf : Array [0..128] of GLuint;// буфер выбора

     const
  // массив свойств материала
  MaterialColor: Array[0..3] of GLfloat = (0.5, 0.2, 0.5, 0.0);
  // идентификатор списка
  CUBE = 1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Render (mode : GLEnum);
var
  i : 0..5;
begin
  {Цикл рисования шести кубиков}
  For i := 0 to 5 do begin
  glPushMatrix;                    // запомнили точку

  glTranslatef (wrkX [i], wrkY [i], 0.0);
  glRotatef (-60 * i, 0.0, 0.0, 1.0); // поворот кубика

  If mode = GL_SELECT then glLoadName (i);
  glCallList (CUBE);               // рисование отдельного кубика - вызов списка

  glPopMatrix;                     // вернулись в точку
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

  Init_GL;
  time := GetTickCount;
  Self.Timer1.Enabled:=true;

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
    If Key = VK_ESCAPE then application.Terminate;
end;


procedure TForm1.OpenGLControl1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  hit, hits: GLUint;
begin
  hits := DoSelect (X, Y);
  Memo1.Clear;
  Memo1.Lines.Add(Format('Объектов под курсором : %d',[hits]));
  For hit := 1 to hits do
    Memo1.Lines.Add(' Объект №' + IntToStr(hit) +
                    ' Имя: ' + IntToStr(SelectBuf[(hit - 1)* 4 + 3]));

end;

procedure TForm1.OpenGLControl1Resize(Sender: TObject);
begin
  glViewport(0, 0, OpenGLControl1.Width , OpenGLControl1.Height);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(18.0, OpenGLControl1.Width / OpenGLControl1.Height, 6.0, 10.0);
  glMatrixMode(GL_MODELVIEW);
  InvalidateRect(Handle, nil, False);
end;

{=======================================================================
Выбор объекта в точке}
function TForm1.DoSelect(x : GLint; y : GLint) : GLUInt;
begin
  glRenderMode(GL_SELECT); // режим выбора
  // режим выбора нужен для работы следующих команд
  glInitNames;             // инициализация стека имен
  glPushName(0);           // помещение имени в стек имен

  glGetIntegerv(GL_VIEWPORT, @vp);

  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPickMatrix(x, ClientHeight - y, 4, 4, @vp);
  gluPerspective(18.0, (ClientWidth - Memo1.Width) / ClientHeight, 6.0, 10.0);
  glViewport(0, 0, (ClientWidth - Memo1.Width), ClientHeight);
  glMatrixMode(GL_MODELVIEW);

  glClear(GL_COLOR_BUFFER_BIT);

  Render(GL_SELECT); // рисуем массив объектов с выбором

  Result := glRenderMode(GL_RENDER);
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var
  ps : TPaintStruct;

begin

Angle := Angle + 0.25 * (GetTickCount - time) * 360 / 10000;
If Angle >= 360.0 then Angle := 0.0;
time := GetTickCount;

glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  init_GL;
// трехмерность
glLoadIdentity;
glTranslatef(0.0, 0.0, -9.0);
glRotatef(120.0, 1.0, 0.0, 1.0);


//WMPaint;
Render (GL_RENDER);
OpenGLControl1.SwapBuffers;
end;

{ Инициализация }
procedure TForm1.Init_gl;
const
light_diffuse : Array [0..3] of GLfloat = (1.0, 1.0, 1.0, 0.0);
light_specular : Array [0..3] of GLfloat = (1.0, 1.0, 1.0, 0.0);
mat_specular : Array [0..3] of GLfloat = (1.0, 1.0, 1.0, 1.0);
lmodel_ambient : Array [0..3] of GLfloat = (0.0, 0.0, 0.0, 0.0);
mat_shininess : GLfloat = 50.0;
var
  i : 0..5;

begin

  glEnable(GL_DEPTH_TEST);// разрешаем тест глубины
  glEnable(GL_LIGHTING); // разрешаем работу с освещенностью
  glEnable(GL_LIGHT0);   // включаем источник света 0

  For i := 0 to 5 do begin
      wrkX [i] := sin (Pi/180*Angle+Pi / 3 * i);
      wrkY [i] := cos (Pi/180*Angle+Pi / 3 * i);
  end;

  glMaterialfv(GL_FRONT, GL_AMBIENT_AND_DIFFUSE, @MaterialColor);

  glNewList (CUBE, GL_Compile);
    glScalef (0.25, 0.25, 0.25); // Изменяем масштаб

    // Стороны куба
    glBegin(GL_QUADS);
      glNormal3f(0.0, 0.0, 1.0);
      glVertex3f(1.0, 1.0, 1.0);
      glVertex3f(-1.0, 1.0, 1.0);
      glVertex3f(-1.0, -1.0, 1.0);
      glVertex3f(1.0, -1.0, 1.0);
    glEnd;

    glBegin(GL_QUADS);
      glNormal3f(-1.0, 0.0, 0.0);
      glVertex3f(-1.0, 1.0, 1.0);
      glVertex3f(-1.0, 1.0, -1.0);
      glVertex3f(-1.0, -1.0, -1.0);
      glVertex3f(-1.0, -1.0, 1.0);
    glEnd;

    glBegin(GL_QUADS);
      glNormal3f(1.0, 0.0, 0.0);
      glVertex3f(1.0, 1.0, 1.0);
      glVertex3f(1.0, -1.0, 1.0);
      glVertex3f(1.0, -1.0, -1.0);
      glVertex3f(1.0, 1.0, -1.0);
    glEnd;

    glBegin(GL_QUADS);
      glNormal3f(0.0, 1.0, 0.0);
      glVertex3f(-1.0, 1.0, -1.0);
      glVertex3f(-1.0, 1.0, 1.0);
      glVertex3f(1.0, 1.0, 1.0);
      glVertex3f(1.0, 1.0, -1.0);
    glEnd;

    glBegin(GL_QUADS);
      glNormal3f(0.0, -1.0, 0.0);
      glVertex3f(-1.0, -1.0, -1.0);
      glVertex3f(1.0, -1.0, -1.0);
      glVertex3f(1.0, -1.0, 1.0);
      glVertex3f(-1.0, -1.0, 1.0);
    glEnd;

    glScalef (4, 4, 4);                // востанавливаем масштаб

  glEndList;                           // конец описания списка
  glClearColor (0.25, 0.1, 0.25, 0.0);
  glSelectBuffer(SizeOf (selectBuf), @selectBuf); // создание буфера выбора

  OpenGLControl1Resize(nil);
glClearColor (0.25, 0.1, 0.25, 0.0);
end;
end.


Теперь нужно приспособить это способ к своей программе или наоборот "свою программу приспособить к способу" бо нормальный интерфейс все же рулит... а то всякие glut32.dll, freeglut32.dll,glfw3.dll,glut32.dll,SDL.dll,SDL_image.dll... задолбали мой "чердак с кукушкой" по полной программе. (Да экзешник ВиАр техно-демки в 400 кб это типа круто, но смысла в нем мало если приходится тащит под пять мегабайт дополнительного хлама сомнительного присхождения )

Зы
Я курсе что инициализация должна работать один раз ... но хотелось проверить в движении, а для этого проще всего было повторить init_GL; в цикле .
Alex2013
долгожитель
 
Сообщения: 2924
Зарегистрирован: 03.04.2013 11:59:44

Re: OpenGL и Стереопара + Использование данных Трекинга в VR

Сообщение Alex2013 » 21.02.2021 10:20:29

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

Добавлено спустя 5 минут 34 секунды:
В далекой цифровой вселенной что-то такое бушевало ....
Изображение

Добавлено спустя 5 часов 7 минут 51 секунду:
Бинарник техно-демки. (Пока только Win64 Собрано в чистом Лазарусе и не требует кучи DLL ))
на ЯД Select_SHA_05_bin.7z Размер: 6,5 МБ
на Гугле Select_SHA_05_bin.7z Размер: 6,5 МБ)

Особенности управления в этой техно-демки :

1 Поддержка "2D ZUI"
ZUI (Zooming User Interface) или МИП (Масштабируемый интерфейс пользователя)
-------------------------
a и d - "стрейф" по X
w и s - "стрейф" по Y
q и e - масштаб .
---------------------------

2 "Переход к 3D" вращение в трехмерном пространстве.

стрелки - "поворот головы" (вращение вокруг осей X и Y)

мышь - тыкаем в окно зажимаем правую кнопку "в влево в право" поворот "вверх и вниз"- масштаб

3 Выбор: Возможность выбора левой кнопкой мышкой "чипов" схемы причем с визуальным отображением и главное при ЛЮБОМ положении в трехмерном пространстве сцены. (редкие сбои есть, но это мелочь поддающаяся коррекции )


Добавлено спустя 7 часов 43 минуты 45 секунд:
"Унифицированный пакет " техно-демки ... (содержит бинарники для Win64 и Win32 .) :idea:
Мелочь, но полезно.
ИзображениеИзображение

:arrow: Select_SHA_05_bin_64_32.7z Размер: 7 МБ :idea:
Зы
В Select_SHA_05 с инициализацией разумеется уже все Ок.
Alex2013
долгожитель
 
Сообщения: 2924
Зарегистрирован: 03.04.2013 11:59:44

Re: OpenGL и Стереопара + Использование данных Трекинга в VR

Сообщение Alex2013 » 28.02.2021 16:03:32

Для полного теста "стереопары" нужно загрузка стерео-текстуры.
В первом варианте техно демки с (применением кучи сторонних DLL и без LCL интерфейса ) она была..
Но кто сказал что без этих самых "сторонних DLL" текстуры не загружается ?
Кто угодно но только не я ! :idea:
Код: Выделить всё
function  LoadTextureBMP(const FileName: String ): GLuint;
var
  i, j: Integer;
  bmp: TBitmap;
    texID : GLuint;
begin
  bmp := TBitmap.Create;
  try

    bmp.LoadFromFile(FileName); // Загрузка рисунка в битовую матрицу.


    // Создадим текстуру
       glEnable(GL_TEXTURE_2D);
       glGenTextures( 1, @texID );
       glBindTexture( GL_TEXTURE_2D, texID );
       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR);
       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);

       glTexImage2D(GL_TEXTURE_2D, 0, 3, bmp.Width,  bmp.Height,
       0, GL_BGR_EXT,GL_UNSIGNED_BYTE, bmp.RawImage.Data);

       gluBuild2DMipmaps (GL_TEXTURE_2D, GL_RGB, bmp.Width, bmp.Height,
          GL_BGR_EXT, GL_UNSIGNED_BYTE,bmp.RawImage.Data);

  finally
    Result := texID;
    bmp.Free;
  end;
end;

:idea: Муа-ха-ха ! (Совершенно непонятно зачем, в 100500 примерах к лазарусу, всюду применяют какие-то дикие "извраты местной промышленности" )
В начале зная "вредные привычки" OpenGL я "ничтоже суетясь" написал две вспомогательные процедуры ...
RGR2BGR и BitmapTest...
Код: Выделить всё
Procedure RGR2BGR(Var Bitmap: TBitmap);
Type
RGB1=Record  b,g,r  : byte; end;
var
X, Y: Integer;
PixelPtr: PInteger;
PixelRowPtr: PInteger;
BytePerPixel: Integer;
BW:Byte;
PRGB:^RGB1;
begin
try
   Bitmap.BeginUpdate(False);
   PixelRowPtr := PInteger(Bitmap.RawImage.Data);
   BytePerPixel := Bitmap.RawImage.Description.BitsPerPixel div 8;
   for Y := 0 to Bitmap.Height - 1 do begin
     PixelPtr := PixelRowPtr;
     for X := 0 to Bitmap.Width - 1 do begin
      PRGB:=Pointer(PixelPtr);
      With PRGB^ do begin
       bw:=R; R:=B;  B:= BW;
       end;
       Inc(PByte(PixelPtr), BytePerPixel);
     end;
     Inc(PByte(PixelRowPtr),Bitmap.RawImage.Description.BytesPerLine);
   end;
finally
   Bitmap.EndUpdate(False);
end;
end;

Function BitmapTest(var TB:TBitmap; Mode:TPixelFormat;
   F_Free:Boolean=true):Boolean ;
   Var
   CB:TBitmap;
   Begin
    Result:= tb.PixelFormat=mode ;
   if not Result then
   begin
   CB:=TBitmap.Create;
   cb.SetSize(tb.Width,tb.Height);
   cb.PixelFormat:=Mode;
   Cb.Canvas.Draw(0,0,TB);
   if F_Free then tb.free;
   Tb:=CB;
   end
   end;

Тоже кстати из серии "за что погибли мухи? "(В старых примерах полно такого тормозного (или нерабочего 64-х битном режиме) БРЕДА что хоть стой хоть падай...)

Но саме смешное в том, что они не понадобились! Стандартный способ загрузки картинок загружает bmp-шки В ТОМ ЖЕ САМОМ формате что требуется для загрузки текстур в OpenGL!!! Нейтрид оверсан ! "В честь памяти Карла все Мухи занесены в красную книгу ..." :mrgreen:

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

:arrow: GL_Select05_VR_05_51_Bin.7z Размер: 3,1 МБ :idea:
Alex2013
долгожитель
 
Сообщения: 2924
Зарегистрирован: 03.04.2013 11:59:44

Re: OpenGL и Стереопара + Использование данных Трекинга в VR

Сообщение Alex2013 » 03.03.2021 02:55:20

Изображение

Нашел и адаптировал загрузчик 3D моделей в формате OBJ ! :idea:
.( формат OBJ текстовый, довольно простой и хорошо документирован, но изобретать велосипед откровенно лень )

Без текстур, но с цветными полигонами . ( Странно, но похоже чем старее OpenGl код тем легче его перемещать в свежий Лазарус этот аж 2001 мохнатого года)
ЗЫ
Это свеже адаптированный модуль целиком ...
Код: Выделить всё
//------------------------------------------------------------------------
//
// Author      : Jan Horn
// Email       : jhorn@global.co.za
// Website     : http://home.global.co.za/~jhorn
// Date        : 13 May 2001
// Version     : 1.0
// Description : Wavefront OPJ loader
//
//------------------------------------------------------------------------
unit OBJLoader;



{$mode Delphi}{$H+}
interface

uses
Windows,SysUtils,FileUtil, Classes,
Math3D, Graphics,
GL,GLExt, glu;

type TColor = Record           // Stores a RGB (0-1) Color
       R, G, B : glFLoat;
     end;
     TCoord = Record           // Stores X, Y, Z coordinates
       X, Y, Z : glFLoat;
     end;
     TTexCoord = Record        // Stores texture coordinates
       U, V : glFloat;
     end;

     TMaterial = Record        // Material Structure
       Name : String;
       Ambient   : TColor;
       Diffuse   : TColor;
       Specular  : TColor;
       Shininess : glFloat;
       Texture   : glUint;     
     end;

     TFace = Record
       Count : Integer;            // Number of vertices in faces
       vIndex : Array of Integer;  // indexes to vertices
       tIndex : Array of Integer;  // indexes to vertex textures
       nIndex : Array of Integer;  // indexes to vertex normals
     end;

     TGroup = Record
       Name : String;
       Faces : Integer;            // Number of faces
       Face  : Array of TFace;     // The faces in the group
       mIndex : Integer;           // index to Material
     end;

     TModel = Record
       Name : String;
       MaterialFile : String;
       Vertices  : Integer;
       Normals   : Integer;
       TexCoords : Integer;
       Groups    : Integer;
       Materials : Integer;
       Vertex    : Array of TCoord;
       Normal    : Array of TCoord;
       TexCoord  : Array of TTexCoord;
       Group     : Array of TGroup;
       Material  : Array of TMaterial;
     end;

  function LoadModel(filename : String) : TModel;
  procedure DrawModel(M : TModel);
 
implementation
{Function PosEx(const substr : AnsiString; const s : AnsiString; const start: Integer ) : Integer ;
var S1 : String;
begin

  S1:=Pos(
end;
}

{------------------------------------------------------------------}
{  Initialises a model                                             }
{------------------------------------------------------------------}
procedure InitModel(var M : TModel);
begin
  with M do
  begin
    Name :='';
    MaterialFile :='';
    Vertices  :=0;
    Normals   :=0;
    TexCoords :=0;
    Groups    :=0;
    Materials :=0;
    SetLength(Vertex, 0);
    SetLength(Normal, 0);
    SetLength(TexCoord, 0);
    SetLength(Group, 0);
    SetLength(Material, 0);
  end;
end;


{------------------------------------------------------------------}
{  Gets the X, Y, Z coordinates from a String                      }
{------------------------------------------------------------------}
function GetCoords(S : String) : TCoord;
var P, P2 : Integer;
    C : TCoord;
begin
  S :=Trim(Copy(S, 3, Length(S)));
  P :=Pos(' ', S);
  //P2 :=PosEx(' ', S, P+1);
  P2 :=Pos(' ', S, P+1);
  S := StringReplace(S, '.', DecimalSeparator, [rfReplaceAll]);

  C.X :=StrToFloat(Copy(S, 1, P-1));
  C.Y :=StrToFloat(Copy(S, P+1, P2-P-1));
  C.Z :=StrToFloat(Copy(S, P2+1, Length(S)));
  Result :=C;
end;


{-------------------------------------------------------------------}
{  Returns the U, V texture coordinates of a texture from a String  }
{-------------------------------------------------------------------}
function GetTexCoords(S : String) : TTexCoord;
var P, P2 : Integer;
    T : TTexCoord;
begin
  P :=Pos(' ', S);
//    P2 :=PosEx(' ', S, P+1);

  P :=Pos(' ', S, P+1);
  S := StringReplace(S, '.', DecimalSeparator, [rfReplaceAll]);

  T.U :=StrToFloat(Copy(S, P+1, P2-P-1));
  T.V :=StrToFloat(Copy(S, P2+1, Length(S)));
  Result :=T;
end;


{------------------------------------------------------------------}
{  Reads Vertex coords, Normals and Texture coords from a String   }
{------------------------------------------------------------------}
procedure ReadVertexData(S : String; var M : TModel);
var C : TCoord;
    T : TTexCoord;
begin
  case S[2] of
    ' ' : begin                      // Read the vertex coords
            C :=GetCoords(S);
            Inc(M.Vertices);
            SetLength(M.Vertex, M.Vertices+1);
            M.Vertex[M.Vertices] :=C;
          end;
    'N' : begin                      // Read the vertex normals
            C :=GetCoords(S);
            Inc(M.Normals);
            SetLength(M.Normal, M.Normals+1);
            M.Normal[M.Normals] :=C;
          end;
    'T' : begin                      // Read the vertex texture coords
            T :=GetTexCoords(S);
            Inc(M.TexCoords);
            SetLength(M.TexCoord, M.TexCoords+1);
            M.TexCoord[M.TexCoords] :=T;
          end;
  end;
end;


{------------------------------------------------------------------}
{  Reads the faces/triangles info for the model                    }
{  Data is stored as "f f f" OR "f/t f/t /ft" OR "f/t/n .. f/t/n"  }
{------------------------------------------------------------------}
procedure ReadFaceData(S : String; var M : TModel);
var P, P2, P3 : Integer;
    F : TFace;
begin
  P :=Pos(' ', S);
  S :=Trim(Copy(S, P+1, length(S)));

  Inc(M.Group[M.Groups].Faces);
  SetLength(M.Group[M.Groups].Face, M.Group[M.Groups].Faces+1);

  F.Count :=0;
  While Length(S) > 0 do
  begin
    P :=Pos('/', S);      // check for position of first /
    P3 :=Pos(' ', S);
    if P3 = 0 then      // if we reach the end
      P3 :=Length(S)+1;

    if P > 0 then              // there are normals or texture coords
    begin
      Inc(F.Count);
      SetLength(F.vIndex, F.Count);
      F.vIndex[F.Count-1] :=StrToInt(Copy(S, 1, P-1));
//   P2 :=PosEx('/', S, P+1);   // check for position of second /
P2 :=Pos('/', S, P+1);   // check for position of second /
      if P2 > P+1 then          // there are normals AND texture coords
      begin
        SetLength(F.tIndex, F.Count);
        SetLength(F.nIndex, F.Count);
        { Change Suggested By Megaes }
        F.tIndex[F.Count-1] :=StrToInt(Copy(S, P+1, P2-P-1));
        F.nIndex[F.Count-1] :=StrToInt(Copy(S, P2+1, P3-P2-1));
        //F.tIndex[F.Count-1] :=StrToInt(Copy(S, P+1, P2-1));
        //F.nIndex[F.Count-1] :=StrToInt(Copy(S, P2+1, P3-1));
      end
      else
      begin
        SetLength(F.nIndex, F.Count);
        F.nIndex[F.Count-1] :=StrToInt(Copy(S, P2+1, P3-1 - P2));
      end;
    end
    else
    begin
      Inc(F.Count);
      SetLength(F.vIndex, F.Count);
      F.vIndex[F.Count-1] :=StrToInt(Copy(S, 1, P3-1));
    end;
    S :=Copy(S, P3+1, length(S));
  end;

  M.Group[M.Groups].Face[M.Group[M.Groups].Faces] :=F;
end;


{------------------------------------------------------------------}
{  Get the name of the material for the group                      }
{------------------------------------------------------------------}
procedure GetMaterialName(S : String; var M : TModel);
var I, P : Integer;
begin
  if copy(S, 1, 6) <> 'USEMTL' then exit;  // false call

  P :=Pos(' ', S);
  S :=Copy(S, P+1, length(S));

  For I :=1 to M.Materials do
    if M.Material[I].Name = S then
      M.Group[M.Groups].mIndex :=I;
end;


{------------------------------------}
{  Create a new material             }
{------------------------------------}
procedure CreateMaterial(S : String; var M : TModel);
begin
  if Copy(S, 1, 6) <> 'NEWMTL' then exit;
  Inc(M.Materials);
  SetLength(M.Material, M.Materials+1);
  S :=Trim(Copy(S, 7, length(S)));
  FillChar(M.Material[M.Materials].Ambient, 0, Sizeof(M.Material[M.Materials].Ambient));
  FillChar(M.Material[M.Materials].Diffuse, 0, Sizeof(M.Material[M.Materials].Diffuse));
  FillChar(M.Material[M.Materials].Specular, 0, Sizeof(M.Material[M.Materials].Specular));
  M.Material[M.Materials].Shininess :=60;
  M.Material[M.Materials].Texture :=0;
  M.Material[M.Materials].Name :=S;
end;


{------------------------------------}
{  Get Material Color values         }
{------------------------------------}
procedure GetMaterial(S : String; var M : TModel);
var C : TColor;
    P, P2 : Integer;
    Ch : Char;
begin
  Ch :=S[2];
  S :=Trim(Copy(S, 3, Length(S)));
  P :=Pos(' ', S);
//  P2 :=PosEx(' ', S, P+1);
  P2 :=Pos(' ', S, P+1);
  S := StringReplace(S, '.', DecimalSeparator, [rfReplaceAll]);

  C.R :=StrToFloat(Copy(S, 1, P-1));
  C.G :=StrToFloat(Copy(S, P+1, P2-P-1));
  C.B :=StrToFloat(Copy(S, P2+1, Length(S)));

  case CH of
    'A' : M.Material[M.Materials].Ambient :=C;
    'D' : M.Material[M.Materials].Diffuse :=C;
    'S' : M.Material[M.Materials].Specular :=C;
  end;
end;


{------------------------------------}
{  Get material specular highlight   }
{------------------------------------}
procedure GetShininess(S : String; var M : TModel);
begin
  S :=Trim(Copy(S, 3, Length(S)));
  S := StringReplace(S, '.', DecimalSeparator, [rfReplaceAll]);

  M.Material[m.Materials].Shininess :=StrToFloat(S);
end;


{------------------------------------}
{  Load texture for material         }
{------------------------------------}
procedure GetTexture(S : String; var M : TModel);
begin
// texturename = get the name from "map_Kd textures/fabric1.rgb"
// LoadTexture( texturename, M.Material[M.Materials].Texture);
end;


{------------------------------------------------------------------}
{  Load the materials from the material file                       }
{------------------------------------------------------------------}
procedure LoadMaterials(S : String; var M : TModel);
var P : Integer;
    filename : String;
    F : TextFile;
begin
  if copy(S, 1, 6) <> 'MTLLIB' then exit;  // false call

  P :=Pos(' ', S);
  filename :=Copy(S, P+1, length(S));
  if FileExists(filename) then
  begin
    AssignFile(F, filename);
    Reset(F);
    while not(EOF(F)) do
    begin
      Readln(F, S);
      if (S <> '') AND (S[1] <> '#') then
      begin
        S :=Uppercase(S);
        Case S[1] of
          'N' : begin
                  if S[2] = 'S' then GetShininess(S, M);  // Get specular highlight amount
                  if S[2] = 'E' then CreateMaterial(S, M);  // create new material
                end;
          'K' : GetMaterial(S, M);     // Material properties
          'M' : GetTexture(S, M);      // Map material to texture
        end;
      end;
    end;
    closeFile(F);
  end
  else
    MessageBox(0, PChar('Cannot find the material file : ' + filename), 'Load Model Material', MB_OK);
end;


{------------------------------------------------------------------}
{  Loads a Alias Wavefront .OBJ file                               }
{------------------------------------------------------------------}
function LoadModel(filename : String) : TModel;
var F : TextFile;
    M : TModel;
    S, S2 : String;
    P : Integer;
begin
  InitModel(M);

  P :=Pos('.', filename)-1;
  if P < 1 then P :=Length(filename);
  M.Name :=Copy(filename, 1, P);

  if FileExists(filename) then
  begin
    AssignFile(F, filename);
    Reset(F);

    while not(EOF(F)) do
    begin
      Readln(F, S);
      if (S <> '') AND (S[1] <> '#') then
      begin
        S :=Uppercase(S);
        case S[1] of
          'G' : begin
                  Inc(M.Groups);
                  SetLength(M.Group, M.Groups+1);
                  S2 :=Trim(Copy(S, 2, length(S)));
                  M.Group[M.Groups].Name :=S2;
                end;
          'V' : ReadVertexData(S, M);  // Read Vertex Date (coord, normal, texture)
          'F' : ReadFaceData(S, M);    // Read faces
          'U' : GetMaterialName(S, M); // Get the material name
          'M' : LoadMaterials(S, M); // Get the material name
        end;
      end;
    end;

    Closefile(F);
  end
  else
    MessageBox(0, PChar('Cannot find the model : ' + filename), 'Load Model', MB_OK);
  result :=M;
end;


{------------------------------------------------------------------}
{  Draws a Alias Wavefront .OBJ model                              }
{------------------------------------------------------------------}
procedure DrawModel(M : TModel);
var I, J, K : Integer;
begin
  For I :=1 to M.Groups do
  begin
    glMaterialfv(GL_FRONT_AND_BACK, GL_DIFFUSE, @M.Material[M.Group[I].mIndex].Diffuse);
    glMaterialfv(GL_FRONT_AND_BACK, GL_SPECULAR, @M.Material[M.Group[I].mIndex].Specular);
    glMaterialfv(GL_FRONT_AND_BACK, GL_AMBIENT, @M.Material[M.Group[I].mIndex].Ambient);
    glMaterialfv(GL_FRONT_AND_BACK, GL_SHININESS, @M.Material[M.Group[I].mIndex].Shininess);

//    if M.Material[M.Group[I].mIndex].Texture <> 0 then  // its a physical texture
//    begin
//      glEnable(GL_TEXTURE_2D);                     // Enable Texture Mapping
//      glBindTexture(GL_TEXTURE_2D, M.Material[M.Group[I].mIndex].Texture);
//    end
//    else
      glDisable(GL_TEXTURE_2D);
    For J :=1 to M.Group[I].Faces do
    begin
      with M.Group[I].Face[J] do
      begin
        case Count of
          3 : glBegin(GL_TRIANGLES);
          4 : glBegin(GL_QUADS);
        else
          glBegin(GL_POLYGON);
        end;

        for K :=0 to Count-1 do
        begin
          if M.Normals > 0 then
            glNormal3fv( @M.Normal[nIndex[K]] );
          if M.TexCoords > 0 then
            glTexCoord2fv( @M.TexCoord[tIndex[K]] );
          glVertex3fv( @M.Vertex[vIndex[K]] );
        end;
        glEnd();
      end;
    end;
  end;
end;

end.



Добавлено спустя 22 часа 8 минут:
ИзображениеИзображение
Сегодня занимался разборкой с динамическими текстурами. Для чего написал простой тестовый стенд. (Вначале хотел сделать сразу с захватом видео но мои лучшие способы захвата видео не захотели работать в 64-х разрядном режиме. так что ограничился модулем захвата скриншотов в качестве источника видео потока )
Alex2013
долгожитель
 
Сообщения: 2924
Зарегистрирован: 03.04.2013 11:59:44

Re: OpenGL и Стереопара + Использование данных Трекинга в VR

Сообщение Alex2013 » 10.03.2021 13:26:19

Вообщем констатирую "маразм крепчал" (в даном случае мой собственный). :cry:

Сделал я просто замечательное ускорение захвата кадров ... (запахал его в отдельный поток)

Ура! Но упс SBS не работает ... Шо ? Где ! А понял! В "левый поток" не приходят флаги от рендера (для отдельного пересчета для левого и правового глаза ) ничтоже суетясь затолкал в захват еще два вызова процедуры захвата ... Не работает?

Ну где "наша не пропадала" запихал в рендер разделение картинки на две половинки . ( Думал нагляднее будет... Ага ! "Нагляднее по самое не хочу" ) Три раза переписал ...

Не фурчит. Наконец вспомнил, что можно влезть в карту верши текстуры. Так заработало. Ушёл спать .

Но "непокорное" разделение достало настолько, что утром написал специальный "Баг тест"...
Код: Выделить всё
procedure CreateSnapshotPlusWH (var B:TBitmap;W,H:Integer;WindowHD:HWND;Sbs:Integer);
  var
      wnd:HWND;
      dc:HDC;
      r:TRect;
      X,WS,HS:Longint;
  begin
  If B=Nil then exit;

      wnd :=WindowHD;
      if wnd = 0 then
          begin
           dc := GetDC(0);
        Ws:=Screen.Width;
        Hs:=Screen.Height;
          end
         else
          begin
          dc := GetWindowDC(wnd);
           GetWindowRect(wnd,r);
           Ws:=r.Right-r.Left;
           Hs:=r.Bottom-r.Top;
          end;

      if SBS in [1,2] then ws:=ws div 2;
      if SBS in [0,1] then X:=0;
      if SBS = 2 then x:=ws;
      b.SetSize(W,H);

  StretchBlt(B.Canvas.Handle,0,0,B.Width,B.Height,DC,x,0,WS,HS,SRCCOPY);
  ReleaseDC(wnd,dc);
  end;

procedure TMForm.Button1Click(Sender: TObject);
procedure GLuKoTest1;
Var
  L,R :TBitmap;
begin
L:=TBitmap.Create; R:=TBitmap.Create;;
CreateSnapshotPlusWH(R,800,600,0,1);
CreateSnapshotPlusWH(L,800,600,0,2);
IMage1.Picture.Assign(R);
IMage2.Picture.Assign(L);
L.Free;
R.Free;
end;
procedure GLuKoTest2;
Var
  C,L,R :TBitmap;
begin
L:=TBitmap.Create;R:=TBitmap.Create;C:=TBitmap.Create;

CreateSnapshotPlusWH(C,800,600,0,0);
L.SetSize(R_W div 2,R_H); R.SetSize(R_W div 2,R_H);

R.Canvas.CopyRect(rect(0,0,R.Width,R.Height),
C.Canvas,rect(0,0,R.Width,C.Height));

L.Canvas.CopyRect(rect(0,0,L.Width,L.Height),
C.Canvas,rect(L.Width,0,C.Width,C.Height));

IMage1.Picture.Assign(R);
IMage2.Picture.Assign(L);

c.Free;
L.Free;
R.Free;
end;

begin
GLuKoTest2;
end;

Это уже исправленная версия ...
Но в начале там было что-то вроде этого.
L.Canvas.CopyRect(rect(0,0,L.Width,L.Height), C.Canvas,rect(0,L.Width,C.Width,C.Height));
Очередная "Жертва копипасты" !

В свое оправдание могу сказать только, что при такой ошибке картинка получается "в Пикассо Стайл " .

Вообщем не пишите программы глубокой ночь, выпив бочку кофе .
Бо на утро, будет как у старины Роберта Вуда который накурившись опиума сделал чудное открытие и даже чудовищным усилием воли заставил себя его записать, но на утро он прочел просто сокрушительную истину "Банан длинен, а его кожура еще длинней!" :mrgreen:
Alex2013
долгожитель
 
Сообщения: 2924
Зарегистрирован: 03.04.2013 11:59:44

Пред.

Вернуться в Lazarus

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

Сейчас этот форум просматривают: Alex2013, Yandex [Bot] и гости: 34

Рейтинг@Mail.ru