Рынок 5D. Проекционные системы

На рынке 5D платформ мы уже более 5 лет. За это время у меня накопился солидный багаж знаний, которыми решил поделиться. В первой части я хочу рассказать о проекционных системах, применяемых в этой отрасли, а так же об адаптации нашего ПО под них. Какие решения мы применяли и почему. Я сознательно не зазываю товарный знак, чтобы не сочли, что пост – это просто реклама очередной программы.
Итак. 5D – это прежде всего кинотеатр со стерео контентом. Ведь звуковые или тактильные ощущения для большинства людей не так важны, как видеоряд.

На рынке сейчас используются следующие технологии:

1. 2-х проекторная система с линейной или круговой поляризацией. Главный минус – частое прогорание поляризационных фильтров.
   
   
2. Стерео “с самодельным” эмиттером, где для синхронизации используется 3-din разъём профессиональных видеокарт nvidia. Главный минус – видеокарту с этим разъёмом сейчас практически не достать.
   
   
3. Nvidia 3D vision, где стандартный эмиттер “взломан” и сигнал синхронизации передаётся на другой, ведь стандартный очень слабый и не стабильный на длинном проводе. Есть производители, которые могут ставить только 301 драйвер, так как дальше NVIDIA улучшила защиту. Но, например, мы решили этот вопрос принципиально по-другому, поэтому нам не страшны эти обновления защиты.
   
   
4. RedPoint синхронизация на основе переходника на VGA кабеле. Где в каждом не чётном кадре вверху ставится маркер в виде красной точки, что бы переходник распознал, где кадр чётный, где нет. Основной минус – это VGA со всем вытекающим качеством картинки.
   
   
5. Различные мультипроекторные решения на основе п.1, п.3 или моно.

И экраны тоже разные:

1. Обычный прямоугольный экран различных пропорций (как правило, по максимуму для зала, реже придерживаясь 16:9 или 4:3).
   
   
2. Прямоугольный основной экран и по бокам 2 не больших экранчика, тоже плоские.
   
   
3. Цилиндрический экран с примерно равным расстоянием от любой точки по одной горизонтали до проектора(-ов).
   
   
4. Различные экраны сложных форм: сферы, неровные стены музеев и т.д.

И стала задача, чтобы рендер работал на всех системах, ОС от win XP до 10 и т.д. Причём, чаще всего, это именно старое железо и windows XP. Написать сам рендер была не проблема, я до этого разрабатывал много крутых штук для ProgDVB, в том числе и его, но тут стала проблема сведения многопроекторных систем. Ведь практически невозможно повесить 2 разных проектора, заставив их светить в одну точку. Для этого раньше приходилось использовались специальные дорогие юстировочные платформы, которые надо было накручивать в течении долгого времени где-то под потолком в неудобной позе, и, так как это механика, то от любого мало-мальски сильного хлопка двери проекторы могли снова “разъехаться”.

Да и с однопроекторными системами тоже не всё так гладко. Сами проекторы хоть и умеют геометрию подстраивать, делают это слишком ступенчато.

Поэтому была взята простая сетка с настройки ТВ канала:

Которую мышкой можно исказить примерно таким вот образом:



Чтобы экране оба проектора начинали светить соответствующими пикселами в одну точку.
Но вручную свести 2 проектора на плоском экране не сложно. Наше же ПО работает и на более сложных системах. Взять, например, 6-ти проекционную систему с цилиндрическим экраном. И так как экран цилиндрический – для каждой из 6 частей “сетки” нужно не просто линейное искажение, а гораздо более сложный алгоритм, который вручную сделать крайне тяжело и долго.


Шестрипроекторная система

Поэтому мною был разработан оптический модуль для автоматической настройки, естественно подстраиваемый под разные экраны и освещение:



Для создания эффекта “не разрывности” “соседних” проекторов используется градиентный переход, затухающий с коэффициентом натурального логарифма (естественно, через простейший обсчёт на пиксельном шейдере линейно заданного цвета в данной точке). Т.е. одна точка имеет цвет (1,1,1), вторая (0,0,0). В результате фрагмент кода шейдера

float cc=log(color)*kj;
float4 c2=rgb*exp(cc);
return c2;

Где kj – подбираемый каждый раз параметр, для каждой конкретной проекционной системы и экрана, который зависит, прежде всего, от того, на сколько чёрный цвет у проектора реально чёрный.

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



И затем остаётся лишь запустить пересчёт. Таким образом сопоставить, опять же, с помощью камеры положение на экране внутри этой настроечной сетки и то, что выводит проектор. То есть подсвечивать отдельные пиксели на проекторе и смотреть где они будут на камере. Но подсвечивать каждый n пиксель – это долго. Для того, что бы пересчёт не затягивать, я вывожу сначала вертикальные линии, затем горизонтальные с определённым шагом. И не забываем, что камера в условиях плохого освещения – штука очень инертная. Поэтому надо ещё правильно подобрать задержку между выводом линии, и ее сканированием.

Немного технических деталей (Delphi). Самая важная функция – это вычисление методом “лесного пожара” области экрана на камере. Пользователь тыкает мышкой или (обычно) пальцем в тачскрин, этим самым задавая отправную точку. Тут важно правильно подобрать освещение для лучшего контраста экран-не-экран.

Подготовка данных

procedure TCam_Geometry_frm.CalcPixelRegion(x,y:integer);
var
   StartP:TPoint;
  I: Integer;
  J: Integer;
  StaPo,EnPo:integer;
begin
   StartP.X := x * InternalBitmap.Width  div Image1.Width;
   StartP.Y := y * InternalBitmap.Height  div Image1.Height;
   SetLength(CheckingMask,InternalBitmap.Height);
   for I := 0 to InternalBitmap.Height - 1 do
   begin
      SetLength(CheckingMask[i],InternalBitmap.Width);
      for J := 0 to InternalBitmap.Width-1 do
      begin
         CheckingMask[i][j].IsCheckPoint := false;
         CheckingMask[i][j].IsPointChecked := false;
         CheckingMask[i][j].typ := 0;
         CheckingMask[i][j].texX := -1;
         CheckingMask[i][j].texY := -1;
      end;
   end;
   SetLength(TempFireBuf,InternalBitmap.Width * InternalBitmap.Height * 4);
   StaPo := 0;
   EnPo := 1;
   TempFireBuf[0].XPos := StartP.X;
   TempFireBuf[0].YPos := StartP.Y;
   CheckingMask[StartP.Y][StartP.X].IsPointChecked := true;
   CheckingMask[StartP.Y][StartP.X].IsCheckPoint := true;
   while StaPo <> EnPo do
   begin
      if (abs(InternalPic.GetRED(TempFireBuf[StaPo].XPos, TempFireBuf[StaPo].YPos)-
      InternalPic.GetRED(TempFireBuf[TempFireBuf[StaPo].pripos].XPos, TempFireBuf[TempFireBuf[StaPo].pripos].YPos))<SpinEdit1.Value) and
         (abs(InternalPic.GetGreen(TempFireBuf[StaPo].XPos, TempFireBuf[StaPo].YPos)-InternalPic.GetGreen(TempFireBuf[TempFireBuf[StaPo].pripos].XPos, TempFireBuf[TempFireBuf[StaPo].pripos].YPos))<SpinEdit1.Value) and
         (abs(InternalPic.GetBlue(TempFireBuf[StaPo].XPos, TempFireBuf[StaPo].YPos)-InternalPic.GetBlue(TempFireBuf[TempFireBuf[StaPo].pripos].XPos, TempFireBuf[TempFireBuf[StaPo].pripos].YPos))<SpinEdit1.Value) then
      begin
         CheckingMask[TempFireBuf[StaPo].YPos][TempFireBuf[StaPo].XPos].IsCheckPoint := true;
        if TempFireBuf[StaPo].XPos > 0 then
        begin
           if not CheckingMask[TempFireBuf[StaPo].YPos][TempFireBuf[StaPo].XPos-1].IsPointChecked then
           begin
              TempFireBuf[EnPo].XPos := TempFireBuf[StaPo].XPos-1;
              TempFireBuf[EnPo].YPos := TempFireBuf[StaPo].YPos;
              TempFireBuf[EnPo].pripos := StaPo;
              CheckingMask[TempFireBuf[EnPo].YPos][TempFireBuf[EnPo].XPos].IsPointChecked := true;
              inc(EnPo);
           end;
        end;
        if TempFireBuf[StaPo].XPos < InternalBitmap.Width - 1 then
        begin
           if not CheckingMask[TempFireBuf[StaPo].YPos][TempFireBuf[StaPo].XPos+1].IsPointChecked then
           begin
              TempFireBuf[EnPo].XPos := TempFireBuf[StaPo].XPos+1;
              TempFireBuf[EnPo].YPos := TempFireBuf[StaPo].YPos;
              TempFireBuf[EnPo].pripos := StaPo;
              CheckingMask[TempFireBuf[EnPo].YPos][TempFireBuf[EnPo].XPos].IsPointChecked := true;
              inc(EnPo);
           end;
        end;
        if TempFireBuf[StaPo].YPos > 0 then
        begin
           if not CheckingMask[TempFireBuf[StaPo].YPos-1][TempFireBuf[StaPo].XPos].IsPointChecked then
           begin
              TempFireBuf[EnPo].XPos := TempFireBuf[StaPo].XPos;
              TempFireBuf[EnPo].YPos := TempFireBuf[StaPo].YPos-1;
              TempFireBuf[EnPo].pripos := StaPo;
              CheckingMask[TempFireBuf[EnPo].YPos][TempFireBuf[EnPo].XPos].IsPointChecked := true;
              inc(EnPo);
           end;
        end;
        if (TempFireBuf[StaPo].YPos < 5) or (TempFireBuf[StaPo].YPos < 5) then
        begin
           ShowMessage('Область выделения подошла опасно к краю. Пордолжение не возможно.');
           exit;
        end;

        if TempFireBuf[StaPo].YPos < InternalBitmap.Height - 1 then
        begin
           if not CheckingMask[TempFireBuf[StaPo].YPos+1][TempFireBuf[StaPo].XPos].IsPointChecked then
           begin
              TempFireBuf[EnPo].XPos := TempFireBuf[StaPo].XPos;
              TempFireBuf[EnPo].YPos := TempFireBuf[StaPo].YPos+1;
              TempFireBuf[EnPo].pripos := StaPo;
              CheckingMask[TempFireBuf[EnPo].YPos][TempFireBuf[EnPo].XPos].IsPointChecked := true;
              inc(EnPo);
           end;
        end;
      end;
      inc(StaPo);
   end;
   SetLength(TempFireBuf,0);
end;

Затем просто этот набор пикселей превращаем в регион, в котором далее и будем искать уже линии.

procedure TCam_Geometry_frm.CreateFrame;
var
   nn:array [1..10] of integer;
   i,j,k,l,tmp:integer;
   rasts:array [1..4]of extended;
   rad:extended;
begin
   for I := 1 to 10 do
      nn[i] := GetMinY(i);
   for k := 0 to 5 do
   for I := 11 to InternalPic.PicX - 1 do
   begin
      if (nn[1] > 0) and (nn[5] > 0) and (nn[10] > 0) and (abs(nn[10]-nn[1])< 7) then
      begin
          tmp := 0;
          for l := 1 to 10 do
             tmp := tmp + nn[l];
          tmp := tmp div 10;
          while nn[5] < tmp do begin
              CheckingMask[nn[5]][i-6].IsCheckPoint := false;
              inc(nn[5]);
          end;
          while nn[5] > tmp do begin
              CheckingMask[nn[5]][i-6].IsCheckPoint := true;
              dec(nn[5]);
          end;
      end;
      for j := 2 to 10 do
         nn[j-1] := nn[j];
      nn[10] := GetMinY(i);
   end;
   for I := 1 to 10 do
      nn[i] := GetMaxY(i);
   for k := 0 to 5 do
   for I := 11 to InternalPic.PicX - 1 do
   begin
      if (nn[1] > 0) and (nn[5] > 0) and (nn[10] > 0) and (abs(nn[10]-nn[1])< 7) then
      begin
          tmp := 0;
          for l := 1 to 10 do
             tmp := tmp + nn[l];
          tmp := tmp div 10;
          while nn[5] <= tmp do begin
              CheckingMask[nn[5]][i-6].IsCheckPoint := false;
              inc(nn[5]);
          end;
          while nn[5] > tmp do begin
              CheckingMask[nn[5]][i-6].IsCheckPoint := true;
              dec(nn[5]);
          end;
      end;
      for j := 2 to 10 do
         nn[j-1] := nn[j];
      nn[10] := GetMaxY(i);
   end;
   rasts[1] := 0;rasts[2] := 0;rasts[3] := 0;rasts[4] := 0;
   Center.X := 0;Center.Y := 0;
   k := 0;
   for I := 11 to InternalPic.PicY - 1 do
      for J := 11 to InternalPic.PicX - 1 do
         if CheckingMask[i][j].IsCheckPoint then
         begin
            Center.X := Center.X + J;
            Center.Y := Center.Y + I;
            inc(k);
         end;
   Center.X := Center.X div k;
   Center.Y := Center.Y div k;
   for I := 11 to InternalPic.PicY - 1 do
      for J := 11 to InternalPic.PicX - 1 do
      begin
         if CheckingMask[i][j].IsCheckPoint then
         begin
            rad := (J-Center.X)*(J-Center.X)+(I-Center.Y)*(I-Center.Y);
            if i < Center.Y then
            begin
               if j < Center.X then
               begin
                  if (rasts[1] < rad) then
                  begin
                     rasts[1] := rad;
                     X1Y1.X := J;
                     X1Y1.Y := I;
                  end;
               end
               else
               begin
                  if (rasts[2] < rad) then
                  begin
                     rasts[2] := rad;
                     X2Y1.X := J;
                     X2Y1.Y := I;
                  end;
               end;
            end
            else
            begin
               if j < Center.X then
               begin
                  if (rasts[3] < rad) then
                  begin
                     rasts[3] := rad;
                     X1Y2.X := J;
                     X1Y2.Y := I;
                  end;
               end
               else
               begin
                  if (rasts[4] < rad) then
                  begin
                     rasts[4] := rad;
                     X2Y2.X := J;
                     X2Y2.Y := I;
                  end;
               end;
            end;
         end;
      end;

   LeftSetkaSide.IsHorisontOnScreen := false;
   LeftSetkaSide.CoordVal := 0;
   LeftSetkaSide.IsHorisontVals := false;
   LeftSetkaSide.x[1] := X1Y1.X;
   LeftSetkaSide.y[1] := X1Y1.Y;
   LeftSetkaSide.x[2] := X1Y2.X;
   LeftSetkaSide.y[2] := X1Y2.Y;

   LeftSetkaSide.y[3] := (LeftSetkaSide.y[1]+LeftSetkaSide.y[2]) / 2;
   LeftSetkaSide.x[3] := GetMinX(Round(LeftSetkaSide.y[3]));

   LeftSetkaSide.y[4] := (LeftSetkaSide.y[1] + LeftSetkaSide.y[3]) / 2;
   LeftSetkaSide.x[4] := GetMinX(Round(LeftSetkaSide.y[4]));
   LeftSetkaSide.y[5] := (LeftSetkaSide.y[2] + LeftSetkaSide.y[3]) / 2;
   LeftSetkaSide.x[5] := GetMinX(Round(LeftSetkaSide.y[5]));

   RightSetkaSide.IsHorisontOnScreen := false;
   RightSetkaSide.CoordVal := 0;
   RightSetkaSide.IsHorisontVals := false;
   RightSetkaSide.x[1] := X2Y1.X;
   RightSetkaSide.y[1] := X2Y1.Y;
   RightSetkaSide.x[2] := X2Y2.X;
   RightSetkaSide.y[2] := X2Y2.Y;

   RightSetkaSide.y[3] := (RightSetkaSide.y[1]+RightSetkaSide.y[2]) / 2;
   RightSetkaSide.x[3] := GetMaxX(Round(RightSetkaSide.y[3]));

   RightSetkaSide.y[4] := (RightSetkaSide.y[1] + RightSetkaSide.y[3]) / 2;
   RightSetkaSide.x[4] := GetMaxX(Round(RightSetkaSide.y[4]));
   RightSetkaSide.y[5] := (RightSetkaSide.y[2] + RightSetkaSide.y[3]) / 2;
   RightSetkaSide.x[5] := GetMaxX(Round(RightSetkaSide.y[5]));

   UpSetkaSide.IsHorisontOnScreen := true;
   UpSetkaSide.CoordVal := 0;
   UpSetkaSide.IsHorisontVals := false;
   UpSetkaSide.x[1] := X1Y1.X;
   UpSetkaSide.y[1] := X1Y1.Y;
   UpSetkaSide.x[2] := X2Y1.X;
   UpSetkaSide.y[2] := X2Y1.Y;

   UpSetkaSide.x[3] := (UpSetkaSide.x[1]+UpSetkaSide.x[2]) / 2;
   UpSetkaSide.y[3] := GetMinY(Round(UpSetkaSide.x[3]));

   UpSetkaSide.x[4] := (UpSetkaSide.x[1]+UpSetkaSide.x[3]) / 2;
   UpSetkaSide.y[4] := GetMinY(Round(UpSetkaSide.x[4]));
   UpSetkaSide.x[5] := (UpSetkaSide.x[2]+UpSetkaSide.x[3]) / 2;
   UpSetkaSide.y[5] := GetMinY(Round(UpSetkaSide.x[5]));

   DownSetkaSide.IsHorisontOnScreen := true;
   DownSetkaSide.CoordVal := 0;
   DownSetkaSide.IsHorisontVals := false;
   DownSetkaSide.x[1] := X1Y2.X;
   DownSetkaSide.y[1] := X1Y2.Y;
   DownSetkaSide.x[2] := X2Y2.X;
   DownSetkaSide.y[2] := X2Y2.Y;

   DownSetkaSide.x[3] := (DownSetkaSide.x[1]+DownSetkaSide.x[2]) / 2;
   DownSetkaSide.y[3] := GetMaxY(Round(DownSetkaSide.x[3]));

   DownSetkaSide.x[4] := (DownSetkaSide.x[1]+DownSetkaSide.x[3]) / 2;
   DownSetkaSide.y[4] := GetMaxY(Round(DownSetkaSide.x[4]));
   DownSetkaSide.x[5] := (DownSetkaSide.x[2]+DownSetkaSide.x[3]) / 2;
   DownSetkaSide.y[5] := GetMaxY(Round(DownSetkaSide.x[5]));
end;

После этого надо лишь сделать все проверки на выход за границы, и рассчитать для каждого пиксела его текстурную координату.

Ну а теперь просто запустим сопоставление.

Основной алгоритм обсчёта

procedure TCam_Geometry_frm.AddLograngeKoeffs(n:integer;byX:boolean;coord:integer);
var
  I, J: integer;
  possx,possy,ccou:integer;
  srX1,srY1:extended;
  lfid:integer;
  foundPoints:arrpo;
  Center:TPoint;
  Clct,Clct2,Clct3,last:TPoint;
  dy,sry,ddy,y:extended;
//  CheAr:array of array of boolean;
begin
   possx := 0;
   possy := 0;
   ccou := 0;
   SetLength(foundPoints,0);
   for I := 0 to Length(ProjSetka[n]) - 1 do
      for J := 0 to Length(ProjSetka[n][i]) - 1 do
      begin
         if (byX and (ProjSetka[n][i][j].ProjX = coord) and IsPossHere(n,j,i,byX,20, 20,srX1,srY1))or
            ((not byX) and (ProjSetka[n][i][j].ProjY = coord) and IsPossHere(n,j,i,byX,20, 20,srX1,srY1))then
         begin
            possx := possx + j;
            possy := possy + i;
            inc(ccou);
            SetLength(foundPoints,ccou);
            foundPoints[ccou-1].X := J;
            foundPoints[ccou-1].Y := I;
         end;
      end;
   if ccou < 10 then
   begin
      possx := -3;
      exit;
   end;

   possx := possx div ccou;
   possy := possy div ccou;
   Center.X := possx; Center.Y := possy;
   lfid := length(LograngeFuncs[n]);
   SetLength(LograngeFuncs[n],length(LograngeFuncs[n])+1);
   LograngeFuncs[n][lfid].IsHorisontOnScreen := false;
   LograngeFuncs[n][lfid].CoordVal := coord;
   LograngeFuncs[n][lfid].IsHorisontVals := byX;

   i := GetMinLengthFromArr(foundPoints,Center);
    if i < 0 then
    begin
       ShowMessage('Не нашли ни одной точки для интерполяции Лагранжа!');
       exit;
    end;
   IsPossHere(n,foundPoints[i].X,foundPoints[i].Y,byX,20, 20,srX1,srY1);
   LograngeFuncs[n][lfid].x[1] := srX1;
   LograngeFuncs[n][lfid].Y[1] := srY1;

   foundPoints[i].X := -1;

   i := GetMaxLengthFromArr(foundPoints,Center);
   IsPossHere(n,foundPoints[i].X,foundPoints[i].Y,byX,20, 20,srX1,srY1);
   LograngeFuncs[n][lfid].x[5] := srX1;
   LograngeFuncs[n][lfid].Y[5] := srY1;

   foundPoints[i].X := -1;
   Clct.X := round(srX1);
   Clct.Y := round(srY1);

   i := GetMaxLengthFromArr(foundPoints,Center);
   while abs(GetAngleFrom3Points(Center,Clct,foundPoints[i])) < Pi / 2 do
   begin
      foundPoints[i].X := -1;
      i := GetMaxLengthFromArr(foundPoints,Center);
      if i < 0 then
      begin
         ShowMessage('Не нашли точки для интерполяции Лагранжа!');
         exit;
      end;
   end;
   IsPossHere(n,foundPoints[i].X,foundPoints[i].Y,byX,20, 20,srX1,srY1);
   LograngeFuncs[n][lfid].x[4] := srX1;
   LograngeFuncs[n][lfid].Y[4] := srY1;
   Clct2.X := round(srX1);
   Clct2.Y := round(srY1);
   LograngeFuncs[n][lfid].x[2] := -1;
   LograngeFuncs[n][lfid].x[3] := -1;
   while (LograngeFuncs[n][lfid].x[2] < 0) or (LograngeFuncs[n][lfid].x[3] < 0) do
   begin
      i := GetNearestFromArr(foundPoints,Center,min(GetLengthBW2P(Center,Clct),GetLengthBW2P(Center,Clct2)) div 2);
      if LograngeFuncs[n][lfid].x[2] < 0 then
      begin
         IsPossHere(n,foundPoints[i].X,foundPoints[i].Y,byX,20, 20,srX1,srY1);
         LograngeFuncs[n][lfid].x[2] := srX1;
         LograngeFuncs[n][lfid].Y[2] := srY1;
         foundPoints[i].X := -1;
         Clct3.X := round(srX1);
         Clct3.Y := round(srY1);
      end
      else
      begin
         if i < 0 then
         begin
            LograngeFuncs[n][lfid].x[3] := last.X;
            LograngeFuncs[n][lfid].Y[3] := last.Y;
         end
         else
         if abs(GetAngleFrom3Points(Center,Clct3,foundPoints[i])) > Pi / 2 then
         begin
            IsPossHere(n,foundPoints[i].X,foundPoints[i].Y,byX,20, 20,srX1,srY1);
            LograngeFuncs[n][lfid].x[3] := srX1;
            LograngeFuncs[n][lfid].Y[3] := srY1;
         end;
      end;
      if i >= 0 then
      begin
         last := foundPoints[i];
         foundPoints[i].X := -1;
      end;
   end;
   if abs(LograngeFuncs[n][lfid].x[1]-LograngeFuncs[n][lfid].x[5]) > abs(LograngeFuncs[n][lfid].y[1]-LograngeFuncs[n][lfid].y[5]) then
   begin
      LograngeFuncs[n][lfid].IsHorisontOnScreen := true;
   end
   else
      LograngeFuncs[n][lfid].IsHorisontOnScreen := false;
   if LograngeFuncs[n][lfid].IsHorisontOnScreen then
   begin
      sry := 0;
      for I := 1 to 5 do
         sry := sry + LograngeFuncs[n][lfid].y[i];
      sry := sry / 5;
      dy := 0;
      for I := 1 to 5 do
         if dy < abs(sry - LograngeFuncs[n][lfid].y[i]) then
            dy := abs(sry - LograngeFuncs[n][lfid].y[i]);
      dy := dy * 3 + 5;
      for I := 10 to 1000 do
      begin
         y := CalcPointByPolinom(n,lfid,i,-1);
         if (y > 0) and(dy < abs(sry - y)) then
         begin
            SetLength(LograngeFuncs[n],length(LograngeFuncs[n])-1);
            exit;
         end;
      end;
   end
   else
   begin
      sry := 0;
      for I := 1 to 5 do
         sry := sry + LograngeFuncs[n][lfid].x[i];
      sry := sry / 5;
      dy := 0;
      for I := 1 to 5 do
         if dy < abs(sry - LograngeFuncs[n][lfid].x[i]) then
            dy := abs(sry - LograngeFuncs[n][lfid].x[i]);
      dy := dy * 3+5;
      for I := 10 to 1000 do
      begin
         y := CalcPointByPolinom(n,lfid,-1,i);
         if (y > 0) and(dy < abs(sry - y)) then
         begin
            SetLength(LograngeFuncs[n],length(LograngeFuncs[n])-1);
            exit;
         end;
      end;
   end;
end;

Применяется вот так:

procedure TCam_Geometry_frm.sButton3Click(Sender: TObject);
var
  I, couu: Integer;
  geom_frms:array of Tcam_geomery_lines_ouput_frm;
  j,l: Integer;
  k, pos: Integer;
begin
   if not sButton1.Enabled then begin FlagStop:=true;exit;end;
   FlagStop:=false;
   SetLength(geom_frms,g_MonitorsCount);
   SetLength(ProjSetka,g_MonitorsCount);
   SetLength(LograngeFuncs,g_MonitorsCount);
   for I := 0 to g_MonitorsCount-1 do
   begin
      geom_frms[i] := Tcam_geomery_lines_ouput_frm.Create(self);
      geom_frms[i].PosX := g_MonitorsSetup[i+1].ScreenPosition.x;
      geom_frms[i].PosY := g_MonitorsSetup[i+1].ScreenPosition.y;
      Application.ProcessMessages;
      SetLength(ProjSetka[i],length(CheckingMask));
      SetLength(LograngeFuncs[i],0);
      for J := 0 to length(CheckingMask)-1 do
      begin
         SetLength(ProjSetka[i][j],length(CheckingMask[j]));
         for k := 0 to length(CheckingMask[j]) - 1 do
         begin
            ProjSetka[i][j][k].ProjX := -1;
            ProjSetka[i][j][k].ProjY:= -1;
         end;
      end;
   end;
   sButton2.Enabled := false;
   sButton1.Enabled := false;
   sButton17.Enabled := false;
   sButton4.Enabled := false;
   sButton5.Enabled := false;

   for I := 0 to g_MonitorsCount-1 do
   begin
      geom_frms[i].Show;
      geom_frms[i].SetBlack;
   end;

     for L := 0 to 40 do
     begin
        Application.ProcessMessages;
        Sleep(20);
     end;

   GetBitmapFromCam(blackBitmap);
   InitPicBuffer(blackPic,blackBitmap.Width,blackBitmap.Height);
   CopyToPic(blackBitmap,0,0,blackPic);

   for I := 0 to g_MonitorsCount-1 do
   begin
     for L := 0 to 70 do
     begin
        Application.ProcessMessages;
        Sleep(20);
     end;

      GetBitmapFromCam(blackBitmap);
      CopyToPic(blackBitmap,0,0,blackPic);

      couu := 16;
      if FlagStop then break;
      for j := 0 to couu do
      begin
         pos := j*geom_frms[i].Width div couu;
         if pos < 4 then pos := 4;
         if pos >= geom_frms[i].Width - 4 then pos := geom_frms[i].Width - 4;

         geom_frms[i].PaintLine(pos,0,pos,geom_frms[i].Height);
         for L := 0 to 70 do
         begin
            Application.ProcessMessages;
            Sleep(20);
         end;
         if not SaveProjLineCoords(i,pos,-1) then FlagStop := true;
         AddLograngeKoeffs(i,true,pos);
         pos := j*geom_frms[i].Height div couu;
         if pos < 4 then pos := 4;
         if pos >= geom_frms[i].Height - 4 then pos := geom_frms[i].Height - 4;
         geom_frms[i].PaintLine(0,pos,geom_frms[i].Width,pos);
         for L := 0 to 70 do
         begin
            Application.ProcessMessages;
            Sleep(20);
         end;
         if not SaveProjLineCoords(i,-1,pos) then FlagStop := true;
         AddLograngeKoeffs(i,false,pos);
         if FlagStop then break;
      end;
      geom_frms[i].SetBlack;
//      geom_frms[i].hide;

      SaveProjSsetka(i);
   end;
   if not FlagStop then
      SetCaptSetkaWidthToOne;
   if not FlagStop then
      CreateProjSetka;

   for I := 0 to g_MonitorsCount-1 do
   begin
      geom_frms[i].Free;
   end;
   if not FlagStop then
      SaveGeometry;
   sButton2.Enabled := true;
   sButton1.Enabled := true;
   sButton17.Enabled := true;
   sButton4.Enabled := true;
   sButton5.Enabled := true;
end;

Всё. Каждый пиксель проектора (из тех, которые возможно) сопоставлен пикселю на экране.

Теперь можно насладиться результатом.



Изображение двоится из-за стерео картинки. В очках всё гораздо интереснее. Пересветы сведения хорошо заметны на камере, так как она сбоку. С платформы, да ещё и в очках эффект минимален.

Другая часть ролика, где эффект 3D минимален и можно оценить именно сведение.



И ещё пара важных замечаний:

Во-первых, обязательно вывод на каждый проектор – это свой поток, со своим кэшем кадров и синхронизацией с vsync. Иначе у вас будет всё или тормозить или рвать картинку. Особенно если проекторов под 12.

Во-вторых, если вы растягиваете картинку 4:3 предположим к 16:9, но картинка мультяшная, и пропорции предметов не очень понятны, больших проблем не будет. Но если вы растянете на цилиндрический экран, всё будет вообще не в пропорции, так как там соотношения 21:9, 27:9 и т.д. Но если показывать в пропорции правильной, то останется крутить 10-12 роликов, которые создавались именно под такой экран, а про остальные забыть.

Выход есть. С помощью так называемого Super zoom можно центральную часть кадра оставлять практически без искажений, а края растягивать. Периферическому зрению пропорции не так важны, а эффект погружения возрастает сильно. В этом методе, конечно, есть много своих минусов, но плюсов больше.

Ожидая вопрос про язык программирования, интерфейс написан на Delphi, весь рендер и управление платформами – на C++.

P.S.: Если тема 5D будет интересна, могу продолжить рассказ о различных протоколах различных платформ или об адаптации готовых unity роликов виртуальной реальности для этой отрасли. Или что-нибудь ещё интересное. В общем, жду комментариев/вопросов.