Автор Тема: Рейтрейсер на FB (FreeBasic)  (Прочитано 626 раз)

0 Пользователей и 1 Гость просматривают эту тему.

Оффлайн Samovar

  • Житель
  • Пятигорье
Рейтрейсер на FB (FreeBasic)
« : 15 Августа 2016, 06:45:17 »
Пока поправил первый вариант из этой темы. http://www.freebasic.net/forum/viewtopic.php?f=7&t=15154
Потихоньку пытаюсь врубиться... Пишу комментарии... позже выложу.
¯\_(ツ)_/¯

Оффлайн Samovar

  • Житель
  • Пятигорье
Re: Рейтрейсер на FB (FreeBasic)
« Ответ #1 : 16 Августа 2016, 16:28:53 »
В общем, пока основное... врублюсь получше, выложу с более подробными комментариями.
Пока такой вариант.
Переключать рейтрейсинг, фотоны и режим просмотра фотонов можно клавишами 1,2,3
Escape - завершение работы. Скорость будет гораздо выше, если за комментировать строку  Sleep(100) в конце кода:

' RayTracing versus PhotonMapping


Type REAL As Single ' Определение типа REAL как Single


' Параметры рендера (константы)
Const As Integer Dimension     = 256*2 ' Размеры квадратного окна рендеринга (степень 2, иначе артефакты)
Const As Integer Types         = 2       ' Количество типов объектов (от 0 до 2): плоскость, сфера, источник света
Const As Integer MaxPhotons    = 3000    ' Максимальное количество фотонов
Const As Integer MaxRelections = 3      ' Максимальное количество отражений
Const As REAL gRadius2         = 0.7   ' Радиус сбора фотонов???
Const As REAL gExposure        = 40      ' Экспозиция (большие значения затемняют картинку)


' Параметры сцены (глобальные переменные)
Dim Shared As Integer Objects(1) = {1,5}      ' Количество объектов в сцене 1 сфера и 5 плоскостей
Dim Shared As REAL gAmbient    = 0.2         ' Окружающий свет
Dim Shared As REAL gOrigin(2)  = {0 ,0 , 0}    ' Положение камеры
Dim Shared As REAL gLight(2)   = {0,1.2,3}   ' Положение источника света
Dim Shared As REAL gSphere(3) =  { -0.5, -0.75, 4, 0.75}   ' Положение сферы и её размер
Dim Shared As REAL gPlanes(4,1) = {{0,  1.5}, _ ' Oриентация и положение 5 плоскостей
                                   {1, -1.5}, _
                                   {0, -1.5}, _
                                   {1,  1.5}, _
                                   {2,  5.0}}
Dim Shared As boolean gPhotonMapping = true ' Фотонный маппинг включён - true, отключён - false
Dim Shared As Integer NumberOfPhotons(1,4)
Dim Shared As REAL gPhotons(1,4,MaxPhotons*5,2,2)
Dim Shared As boolean gIntersect
Dim Shared As Integer gType
Dim Shared As Integer gIndex
Dim Shared As REAL gDist2, gDist
Dim Shared As REAL gPoint(2)
Dim Shared As boolean gEmpty = true
Dim Shared As boolean gView3D
Dim Shared As Integer pRow, pCol, pIteration, pMax


' Декларация подпрограмм
Declare Sub GatherPhotons(r() As REAL, p() As REAL,typ As Integer, index As Integer)
Declare Sub GetColor(r() As REAL, rgbIn() As REAL, typ As Integer, index As Integer)
Declare Sub StorePhoton(typ As Integer,index As Integer, _
                        location() As REAL,direction() As REAL,energy() As REAL)
Declare Sub ShadowPhoton(ray() As REAL)
Declare Sub DrawPhoton(frgb() As REAL,p() As REAL)
Declare Sub ResetRender
Declare Sub Render


' Директивы препроцессора
#define min(a,b) IIf(a<b,a,b) ' Макрос минимум из a и b
#define max(a,b) IIf(a>b,a,b)   ' Макрос максимум из a и b


#Macro NormalizeVec(r,v)
  Scope
  Dim As REAL L2 = v(0)*v(0)+v(1)*v(1)+v(2)*v(2)
  If l2<>0 Then L2=1.0/Sqr(L2)
  r(0)=v(0)*L2
  r(1)=v(1)*L2
  r(2)=v(2)*L2
  End Scope
#EndMacro


#Macro SubVec(r,a,b)
  r(0)=a(0)-b(0)
  r(1)=a(1)-b(1)
  r(2)=a(2)-b(2)
#EndMacro


#Macro AddVec(r,a,b)
  r(0)=a(0)+b(0)
  r(1)=a(1)+b(1)
  r(2)=a(2)+b(2)
#EndMacro


#Macro MulScalarVec(r,a,b)
  r(0)=a(0)*b
  r(1)=a(1)*b
  r(2)=a(2)*b
#EndMacro


#define DotProduct(a,b) (a(0)*b(0) + a(1)*b(1) + a(2)*b(2))


#define rnd2 (Rnd-Rnd)


#Macro RandomVec(r)
  r(0)=Rnd-Rnd
  r(1)=Rnd-Rnd
  r(2)=Rnd-Rnd
#EndMacro


#define odd(xx) (xx And 1)




Function Distance2(a() As REAL, _
                   b() As REAL, _
                   d2 As REAL) As boolean
  Dim As REAL c = a(0) - b(0)
  Dim As REAL d = c*c
  If (d > d2) Then Return false
  c = a(1) - b(1)
  d += c*c
  If (d > d2) Then Return false
  c = a(2) - b(2)
  d += c*c
  If (d > d2) Then Return false
  gDist2 = d2
  Return true
End Function


Sub RaySphere(idx As Integer,r() As REAL, o() As REAL)
  Dim As REAL s(2)
  SubVec(s,gSphere,o)
  Dim As REAL radius = gSphere(3)
  Dim As REAL A = DotProduct(r,r)
  Dim As REAL B = -2.0 * DotProduct(s,r)
  Dim As REAL C = DotProduct(s,s) - (radius*radius)
  Dim As REAL D = B*B - 4*A*C
  If (D < 0.0) Then Return
  Dim As REAL sign  = IIf(C < -0.00001,1,-1)
  Dim As REAL l = (-B + sign*Sqr(D))/(2*A)
  If (l<0) Or (l>gDist) Then Return
  gType  = 0
  gIndex = idx
  gDist  = l
  gIntersect = true
End Sub


Sub RayPlane(idx As Integer, r() As REAL,o() As REAL)
  Dim As Integer axis = gPlanes(idx,0)
  If r(axis)=0 Then Return
  Dim As REAL l = (gPlanes(idx,1) - o(axis)) / r(axis)
  If (l<0) Or (l>gDist) Then Return
  gType  = 1
  gIndex = idx
  gDist  = l
  gIntersect = true 
End Sub


Sub RayObject(typ As Integer, idx As Integer, r()As REAL, o() As REAL)
  If (typ = 0) Then
    RaySphere(idx,r(),o())
  Else
    RayPlane(idx,r(),o())
  End If
End Sub


Sub SphereNormal(r() As REAL,P() As REAL)
  Dim As REAL v(2)
  SubVec(v,P,gSphere)
  NormalizeVec(r,v)
End Sub


Sub PlaneNormal(r() As REAL, idx As Integer, P() As REAL, O() As REAL)
  Dim As Integer axis = gPlanes(idx,0)
  Dim As REAL N(2)
  N(axis) = O(axis) - gPlanes(idx,1)
  NormalizeVec(r,N)
End Sub


Sub SurfaceNormal(r() As REAL, _
                  typ As Integer, _
                  idx As Integer, _
                  P() As REAL, _
                  Inside() As REAL)
  If (typ = 0) Then
    SphereNormal(r(),P())
  Else
    PlaneNormal(r(),idx,P(),Inside())
  End If
End Sub


Sub MirrorVec(Ret() As REAL,_
              Ray() As REAL, _
              FromPoint() As REAL)
  Dim As REAL N(2)=Any,tmp(2)=Any
  SurfaceNormal(N(),gType, gIndex, gPoint(), fromPoint())
  MulScalarVec(tmp,N,(2 * DotProduct(ray,N) ))
  SubVec(tmp,ray,tmp)
  NormalizeVec(Ret,tmp)
End Sub


'
' Освещение
'
Function LightDiffuse(N() As REAL,P() As REAL) As REAL
  Dim As REAL L(2)=Any
  SubVec(L,gLight,P)
  NormalizeVec(L,L)
  Return DotProduct(N,L)
End Function


Function LightObject(typ As Integer, _
                     idx As Integer, _
                     P() As REAL, _
                     Ambient As REAL ) As REAL
  Dim As REAL N(2)=Any
  SurfaceNormal(N(),typ, idx, P(), gLight())
  Dim As REAL L = LightDiffuse(N() , P() )
  Return min(1.0, max(L, Ambient))
End Function


'
' Рейтрейсинг (трассировка лучей)
'
Sub Raytrace(ray() As REAL,origin() As REAL)
  gIntersect = false
  gDist      = 999999.9
  For typ As Integer = 0 To Types-1
    For idx As Integer = 0 To Objects(typ)-1
      RayObject(typ,idx,ray(),origin())
    Next idx
  Next typ
End Sub


Sub AbsorbColor(ret() As REAL, _
                rgbIn() As REAL, _
                r As REAL,g As REAL,b As REAL) ' e.g. White Light Hits Red Wall
  Dim As REAL rgbOut(2)={r,g,b}
  For c As Integer =0 To 2
    ret(c) = min(rgbOut(c),rgbIn(c))
  Next
End Sub


Sub GetColor(r() As REAL, _
            rgbIn() As REAL, _
            typ As Integer, _
            idx As Integer)
  If (typ=0) Then     ' сфера
    AbsorbColor(r(),rgbIn(), 1, 1, 0.5)
  ElseIf (typ=1) Then ' плоскость
    If idx=0 Then
      AbsorbColor(r(),rgbIn(), 1.0, 0, 0)
    ElseIf idx=2 Then
      AbsorbColor(r(),rgbIn(), 0, 1.0, 0)
    Else 
      AbsorbColor(r(),rgbIn(), 1, 1, 1)
    End If
  End If
End Sub


Sub ComputePixelColor(prgb() As REAL,x As REAL,y As REAL)
  Dim As REAL ray(2) = {  x/Dimension - 0.5 , _
                          -(y/Dimension - 0.5), _
                                          1.0}
  Raytrace(ray(), gOrigin())
  If (gIntersect)  Then
    MulScalarVec(gPoint,ray,gDist)
    If (gType = 0) Then
      MirrorVec(ray(),ray(),gOrigin())
      Raytrace(ray(), gPoint())
      If (gIntersect) Then
        Dim As REAL tmp(2)=Any
        MulScalarVec(tmp,ray,gDist)
        AddVec(gPoint,tmp,gPoint)
      End If
    End If
 
    If (gPhotonMapping) Then
      GatherPhotons(prgb(),gPoint(),gType,gIndex)
    Else
      Dim As Integer tType  = gType
      Dim As Integer tIndex = gIndex
      Dim As REAL a = gAmbient
      Dim As REAL tmp(2)=Any
      SubVec(tmp,gPoint,gLight)
      Raytrace(tmp(),gLight())
      If (tType = gType) And (tIndex = gIndex) Then
        a = LightObject(gType, gIndex, gPoint(), gAmbient)
      End If
      prgb(0)=a:prgb(1)=a:prgb(2)=a
      GetColor(prgb(),prgb(),tType,tIndex)
    End If
  End If
End Sub


'
' Фотонный маппинг
'
Sub GatherPhotons(energy() As REAL, _
                  p() As REAL, _
                  typ As Integer, _
                  idx As Integer)
  Dim As REAL N(2)=Any
  Dim As REAL tmp(2)=Any
  Dim As REAL g(2)=Any
  Dim As REAL weight=Any
  Dim As REAL frgb(2)=Any
  SurfaceNormal(N(), typ, idx, p(), gOrigin())


  For i As Integer = 0  To  NumberOfPhotons(typ,idx)-1
    ' положение
    g(0)=gPhotons(typ,idx,i,0,0)
    g(1)=gPhotons(typ,idx,i,0,1)
    g(2)=gPhotons(typ,idx,i,0,2)
    If (Distance2(p(),g(),gRadius2)) Then
      ' направление
      g(0)=gPhotons(typ,idx,i,1,0)
      g(1)=gPhotons(typ,idx,i,1,1)
      g(2)=gPhotons(typ,idx,i,1,2)
      weight = max(0.0, -DotProduct(N,g) )
      weight *= (1.0 - Sqr(gDist2)) / gExposure
      ' энергия
      g(0)=gPhotons(typ,idx,i,2,0)
      g(1)=gPhotons(typ,idx,i,2,1)
      g(2)=gPhotons(typ,idx,i,2,2)
      MulScalarVec(tmp,g,weight)
      AddVec(frgb,frgb,tmp)
    End If
  Next i
  For j As Integer=0 To 2
    energy(j)=max(0,min(1,frgb(j) ) )
  Next j
End Sub


Sub EmitPhotons
  Randomize 1
  Dim As REAL frgb(2)=Any
  Dim As REAL ray(2)=Any
  Dim As REAL p(2)=Any
  For typ As Integer = 0 To Types-1
    For idx As Integer = 0 To Objects(typ)-1
      NumberOfPhotons(typ,idx) = 0
    Next idx
  Next typ
  For i As Integer = 0 To MaxPhotons-1
    Dim As Integer bounces = 1
    ' белый цвет фотона
    frgb(0)=1:frgb(1)=1:frgb(2)=1
    RandomVec(ray)
    NormalizeVec(ray,ray)
    p(0) = gLight(0)
    p(1) = gLight(1)
    p(2) = gLight(2)
    While (p(1) >= gLight(1))
      Dim As REAL N(2)=Any
      RandomVec(N)
      NormalizeVec(N,N)
      MulScalarVec(N,N,0.75)
      AddVec(p,gLight,N)
    Wend
   
    Raytrace(ray(), p())
       
    If Abs(p(0) > 1.5) Then Continue For
    If Abs(p(1) > 1.5) Then  Continue For
    If Distance2(p(), gSphere(),gSphere(3)*gSphere(3)) Then  Continue For
    While (gIntersect<>0) And (bounces <= MaxRelections)
      Dim As REAL tmp(2)=Any
      MulScalarVec(tmp,ray,gDist)
      AddVec(gPoint, tmp, p)
      GetColor(frgb(),frgb(),gType,gIndex)
      MulScalarVec(frgb,frgb, 1.0/Sqr(bounces))
      StorePhoton(gType, gIndex, gPoint(), ray(),frgb())
      DrawPhoton(frgb(), gPoint())
      ShadowPhoton(ray())
      MirrorVec(ray(),ray(),p())
      Raytrace(ray(), gPoint())
      p(0) = gPoint(0)
      p(1) = gPoint(1)
      p(2) = gPoint(2)
      bounces+=1
    Wend
  Next i
End Sub


Sub StorePhoton(typ As Integer, _
                idx As Integer, _
                l() As REAL,_
                d() As REAL, _
                e() As REAL)
  Dim As Integer Photon=NumberOfPhotons(typ,idx)
  For i As Integer=0 To 2
    gPhotons(typ,idx,Photon,0,i) = l(i) ' Положение
    gPhotons(typ,idx,Photon,1,i) = d(i) ' Направление
    gPhotons(typ,idx,Photon,2,i) = e(i) ' Энергия
  Next
  NumberOfPhotons(typ,idx)=Photon+1
End Sub


Sub ShadowPhoton(ray() As REAL)
  Dim As REAL shadow(2) = {-0.25,-0.25,-0.25}
  Dim As REAL tPoint(2) = {gPoint(0), gPoint(1),gPoint(2)}
  Dim As Integer tType  = gType ' Save State
  Dim As Integer tIndex = gIndex
  Dim As REAL BumpedPoint(2)
  MulScalarVec(BumpedPoint,ray,0.000001)
  AddVec(BumpedPoint,gPoint,BumpedPoint)
  Raytrace(ray(), BumpedPoint())
  Dim As REAL ShadowPoint(2)=Any
  MulScalarVec(ShadowPoint,ray,gDist)
  AddVec(ShadowPoint,ShadowPoint, BumpedPoint) ' 3D точка
  StorePhoton(gType, gIndex, ShadowPoint(), ray(), shadow())
  gPoint(0) = tPoint(0)
  gPoint(1) = tPoint(1)
  gPoint(2) = tPoint(2)
  gType  = tType
  gIndex = tIndex
End Sub


'
' Рендеринг (визуализация)
'
Sub Render
  Dim As Integer x,y,iterations = 0
  Dim As Integer nruns
  nruns=256
  While (iterations < nruns)
    nruns=max(pMax, 256)
    If (pCol >= pMax) Then
      pRow+=1
      pCol = 0
      If (pRow >= pMax) Then
        pIteration+=1
        pRow = 0
        pMax = Int(2^pIteration)
      End If
    End If
    Dim As Integer pNeedsDrawing = (pIteration = 1) Or odd(pRow) _
                                 Or ( (odd(pRow)=0) And odd(pCol))
    x = pCol * (Dimension/pMax)
    y = pRow * (Dimension/pMax)
   
    pCol+=1
   
    If (pNeedsDrawing) Then
      iterations+=1
      Dim As REAL b(2)
      ComputePixelColor(b(),x,y)
      Dim As UInteger col=RGB(b(0)*255,b(1)*255,b(2)*255)
      Line (x,y)-Step((Dimension/pMax)-1,(Dimension/pMax)-1),col,BF ' Возможность отрисовки увеличенного пикселя
      'pset (x,y),col
    End If
  Wend
  If (pRow = Dimension-1) Then
    gEmpty = false
  End If
End Sub


Sub ResetRender()
  pRow=0
  pCol=0
  pIteration=1
  pMax=2
  gEmpty=true
  If (gPhotonMapping And Not gView3D) Then
    EmitPhotons()
  End If
End Sub




Sub setup()
  ScreenRes Dimension,Dimension,24
  ResetRender
End Sub


Sub drawit()
  If gPhotonMapping Then
    WindowTitle "[1]Рейтрейсинг [3]Просмотр фотонов"
  Else
    WindowTitle "[2]Фотонная карта [3]Просмотр фотонов"
  End If
  If (gView3D) Then
    If (gEmpty) Then
      Cls
      EmitPhotons()
      gEmpty = false
    End If
  Else
    If (gEmpty) Then
      Render()
    End If
  End If
End Sub


Sub DrawPhoton(frgb() As REAL,p() As REAL)
  If (gView3D=true) And cbool(p(2) > 0.0) Then
    Dim As Integer x = (Dimension/2) + Int(Dimension *  p(0)/p(2))
    Dim As Integer y = (Dimension/2) + Int(Dimension * -p(1)/p(2))
    If (y <= Dimension) Then
      PSet (x,y),RGB(frgb(0)*255,frgb(1)*255,frgb(2)*255)
    End If
  End If
End Sub


Sub SwitchToMode(i As String)
  If (i="1") Then
    gView3D = false
    gPhotonMapping = false
    ResetRender()
  ElseIf (i="2") Then
    gView3D = false
    gPhotonMapping = true 
    ResetRender()
  ElseIf (i="3") Then
    gView3D = true
    ResetRender()
  End If
End Sub


'
' Основная программа
'
Dim As String key      ' Переменная символа нажатой клавиши
setup()                ' Установка размеров окна и сброс рендера
While key<>Chr(27)    ' Выполняет программу пока не нажата клавиша Esc
  key=InKey
  If key="1" Or key="2" Or key="3" Then
    SwitchToMode(key)' Сброс рендера и переключение в режим отображения по символу нажатой клавиши
    key=""
  End If 
  drawit()             ' Отрисовка заголовка окна и рендер 256 пикселей
  Sleep(100)          ' Пауза 100 миллисекунд
Wend
¯\_(ツ)_/¯

Оффлайн sungreen

  • ...
  • Житель
  • Kostroma mon amour
    • sungreen.github.io
Re: Рейтрейсер на FB (FreeBasic)
« Ответ #2 : 16 Августа 2016, 22:22:14 »
... вроде есть Operator Overloading в FreeBasic http://free-basic.ru/helprus/ProPgOperatorOverloading.html ...
... интересно было бы переопределить операции с векторами типа V0 = V1+V2 и т.п. ...
Для Кота

Оффлайн sungreen

  • ...
  • Житель
  • Kostroma mon amour
    • sungreen.github.io
Re: Рейтрейсер на FB (FreeBasic)
« Ответ #3 : 16 Августа 2016, 22:23:37 »
Для Кота

Оффлайн LanuHum

  • Житель
Re: Рейтрейсер на FB (FreeBasic)
« Ответ #4 : 16 Августа 2016, 23:00:19 »
fbc -w all "fbray.bas" (в каталоге: /home/leonid/workspace/programming/freebasic)
fbray.bas(27) error 14: Expected identifier, found 'boolean' in 'Dim Shared As boolean gPhotonMapping = true ' Фотонный маппинг включён - true, отключён - false'
fbray.bas(30) error 14: Expected identifier, found 'boolean' in 'Dim Shared As boolean gIntersect'
fbray.bas(35) error 14: Expected identifier, found 'boolean' in 'Dim Shared As boolean gEmpty = true'
fbray.bas(36) error 14: Expected identifier, found 'boolean' in 'Dim Shared As boolean gView3D'
fbray.bas(108) error 14: Expected identifier, found 'boolean' in 'd2 As REAL) As boolean'
fbray.bas(111) error 41: Variable not declared, false in 'If (d > d2) Then Return false'
fbray.bas(119) error 41: Variable not declared, true in 'Return true'
fbray.bas(138) error 41: Variable not declared, gIntersect in 'gIntersect = true'
Сборка завершилась с ошибкой.
fbray.bas(283) error 41: Variable not declared, gPhotonMapping in 'If (gPhotonMapping) Then'
fbray.bas(466) error 41: Variable not declared, gEmpty in 'gEmpty = false'
fbray.bas(466) error 132: Too many errors, exiting

Оффлайн LanuHum

  • Житель
Re: Рейтрейсер на FB (FreeBasic)
« Ответ #5 : 16 Августа 2016, 23:27:35 »
Дописал вначале:
Enum boolean
    false = 0, true = Not false
End Enum
Осталась одна ошибка:
fbray.bas(514) error 41: Variable not declared, cbool in 'If (gView3D=true) And cbool(p(2) > 0.0) Then'

Оффлайн sungreen

  • ...
  • Житель
  • Kostroma mon amour
    • sungreen.github.io
Re: Рейтрейсер на FB (FreeBasic)
« Ответ #6 : 17 Августа 2016, 02:39:16 »
... какая версия компилятора? ...
Для Кота

Оффлайн Samovar

  • Житель
  • Пятигорье
Re: Рейтрейсер на FB (FreeBasic)
« Ответ #7 : 17 Августа 2016, 15:54:42 »
... вроде есть Operator Overloading в FreeBasic http://free-basic.ru/helprus/ProPgOperatorOverloading.html ...
... интересно было бы переопределить операции с векторами типа V0 = V1+V2 и т.п. ...

Озадачил :) Макросами  и массивами оно ещё как-то в голове укладывалось :) Ещё б понимать саму работу проги и шарить в векторной алгебре :)
Благодарю. Интересно. Теперь "курю"  в этом направлении:
http://free-basic.ru/overloadfunction.html
http://free-basic.ru/overloadoperator.html


Цитировать
... кстати вот есть лаба http://ext.freebasic.net/dev-docs/files/ext/math/vector3-bi.html#Vector3 ...

Поставил... встала криво :( ...или я чего-то не так намутил... но векторы работают... Ещё раз спасибо! Полезная библиотека.

Цитировать
Дописал вначале:
Enum boolean
    false = 0, true = Not false
End Enum
Осталась одна ошибка:
fbray.bas(514) error 41: Variable not declared, cbool in 'If (gView3D=true) And cbool(p(2) > 0.0) Then'


Это не прокатит... переменные, это ж не константы...
Скорее всего, действительно с компилятором не то... Поставь лучше пока  1.05.0  x86   
В русской справке отсутствует инфа по типу boolean, но в справке от разработчиков есть: http://www.freebasic.net/wiki/wikka.php?wakka=KeyPgBoolean
так же присутствует и конвертер cbool http://www.freebasic.net/wiki/wikka.php?wakka=KeyPgCbool
« Последнее редактирование: 17 Августа 2016, 15:59:27 от Samovar »
¯\_(ツ)_/¯

Оффлайн LanuHum

  • Житель
Re: Рейтрейсер на FB (FreeBasic)
« Ответ #8 : 17 Августа 2016, 16:12:33 »
... какая версия компилятора? ...

1.00

Цитировать
Это не прокатит... переменные, это ж не константы...

У меня сейчас нет времени, но вчера, когда я пытался найти инфу об ошибках, вычитал, что с какой-то обновлённой версии начинается эта ерунда. Якобы, у фрибейсика нету, собственно, типа boolean
http://freebasic.net/forum/viewtopic.php?t=23488
http://www.freebasic.net/forum/viewtopic.php?t=20913
Сам костыль взял отсюда:
http://freebasic.net/forum/viewtopic.php?t=14445


Цитировать
и шарить в векторной алгебре :)

http://mathprofi.ru/matematika_dlya_chainikov.html
« Последнее редактирование: 17 Августа 2016, 16:29:11 от LanuHum »

Оффлайн Samovar

  • Житель
  • Пятигорье
Re: Рейтрейсер на FB (FreeBasic)
« Ответ #9 : 17 Августа 2016, 16:35:04 »
Почему у тебя не работает: https://sourceforge.net/p/fbc/news/?source=navbar
Начиная с FreeBASIC 1.04.0 released
Если надо совсем последнюю сборку, то лучше глядеть на немецком сайте: http://users.freebasic-portal.de/stw/builds/

Цитировать
Цитировать
и шарить в векторной алгебре :)

http://mathprofi.ru/matematika_dlya_chainikov.html

я хоть в что-то новое для себя пытаюсь врубиться, с твоей подачи, а ты, походу, вернулся к тому, с чего начал... :)  или и не начинал... :-\
« Последнее редактирование: 17 Августа 2016, 16:57:58 от Samovar »
¯\_(ツ)_/¯

Оффлайн sungreen

  • ...
  • Житель
  • Kostroma mon amour
    • sungreen.github.io
Re: Рейтрейсер на FB (FreeBasic)
« Ответ #10 : 17 Августа 2016, 17:01:04 »
... какая версия компилятора? ...
1.00

... повышай, поскольку cbool был введен позднее ...
Для Кота

Оффлайн Samovar

  • Житель
  • Пятигорье
Re: Рейтрейсер на FB (FreeBasic)
« Ответ #11 : 18 Августа 2016, 13:17:07 »
Дописал вначале:
Enum boolean
    false = 0, true = Not false
End Enum
Осталась одна ошибка:
fbray.bas(514) error 41: Variable not declared, cbool in 'If (gView3D=true) And cbool(p(2) > 0.0) Then'
Погорячился вчера. Не разобрался сразу. Это вполне работоспособно. Беру свои слова обратно.
За ссылку на сайт по алгебре спасибо.


Попробуй обойтись без cbool, переписав строку так:


  If (gView3D=true) And Int(p(2) > 0.0) Then


Можешь и без boolean обойтись, заменив все true единицами, а false нулями, а вместо типа boolean использовать тип Byte



' RayTracing versus PhotonMapping


Type REAL As Single ' Определение типа REAL как Single


' Параметры рендера (константы)
Const As Integer Dimension     = 256*2 ' Размеры квадратного окна рендеринга (степень 2, иначе артефакты)
Const As Integer Types         = 2 ' Количество типов объектов (от 0 до 2): плоскость, сфера, источник света
Const As Integer MaxPhotons    = 3000 ' Максимальное количество фотонов
Const As Integer MaxRelections = 3 ' Максимальное количесво отражений
Const As REAL gRadius2         = 0.7 ' Радиус сбора фотонов???
Const As REAL gExposure        = 40 ' Экспозиция (большие значения затемняют картинку)


' Параметры сцены (глобальные переменные)
Dim Shared As Integer Objects(1) = {1,5} ' Количество объектов в сцене 1 сфера и 5 плоскостей
Dim Shared As REAL gAmbient    = 0.2 ' Окружающий свет
Dim Shared As REAL gOrigin(2)  = {0 ,0 , 0} ' Положение камеры
Dim Shared As REAL gLight(2)   = {0,1.2,3} ' Положение источника света
Dim Shared As REAL gSphere(3) =  { -0.5, -0.75, 4, 0.75} ' Положение сферы и её размер
Dim Shared As REAL gPlanes(4,1) = {{0,  1.5}, _ ' Oриентация и положение 5 плоскостей
                                   {1, -1.5}, _
                                   {0, -1.5}, _
                                   {1,  1.5}, _
                                   {2,  5.0}}
Dim Shared As Byte gPhotonMapping = 1 ' Фотонный маппинг включён - 1, отключён - 0
Dim Shared As Integer NumberOfPhotons(1,4)
Dim Shared As REAL gPhotons(1,4,MaxPhotons*5,2,2)
Dim Shared As Byte gIntersect
Dim Shared As Integer gType
Dim Shared As Integer gIndex
Dim Shared As REAL gDist2, gDist
Dim Shared As REAL gPoint(2)
Dim Shared As Byte gEmpty = 1
Dim Shared As Byte gView3D
Dim Shared As Integer pRow, pCol, pIteration, pMax


' Декларация подпрограмм
Declare Sub GatherPhotons(r() As REAL, p() As REAL,typ As Integer, index As Integer)
Declare Sub GetColor(r() As REAL, rgbIn() As REAL, typ As Integer, index As Integer)
Declare Sub StorePhoton(typ As Integer,index As Integer, _
                        location() As REAL,direction() As REAL,energy() As REAL)
Declare Sub ShadowPhoton(ray() As REAL)
Declare Sub DrawPhoton(frgb() As REAL,p() As REAL)
Declare Sub ResetRender
Declare Sub Render


' Директивы препроцессора
#define min(a,b) IIf(a<b,a,b) ' Макрос минимум из a и b
#define max(a,b) IIf(a>b,a,b) ' Макрос максимум из a и b


#Macro NormalizeVec(r,v)
  Scope
  Dim As REAL L2 = v(0)*v(0)+v(1)*v(1)+v(2)*v(2)
  If l2<>0 Then L2=1.0/Sqr(L2)
  r(0)=v(0)*L2
  r(1)=v(1)*L2
  r(2)=v(2)*L2
  End Scope
#EndMacro


#Macro SubVec(r,a,b)
  r(0)=a(0)-b(0)
  r(1)=a(1)-b(1)
  r(2)=a(2)-b(2)
#EndMacro


#Macro AddVec(r,a,b)
  r(0)=a(0)+b(0)
  r(1)=a(1)+b(1)
  r(2)=a(2)+b(2)
#EndMacro


#Macro MulScalarVec(r,a,b)
  r(0)=a(0)*b
  r(1)=a(1)*b
  r(2)=a(2)*b
#EndMacro


#define DotProduct(a,b) (a(0)*b(0) + a(1)*b(1) + a(2)*b(2))


#define rnd2 (Rnd-Rnd)


#Macro RandomVec(r)
  r(0)=Rnd-Rnd
  r(1)=Rnd-Rnd
  r(2)=Rnd-Rnd
#EndMacro


#define odd(xx) (xx And 1)




Function Distance2(a() As REAL, _
                   b() As REAL, _
                   d2 As REAL) As Byte
  Dim As REAL c = a(0) - b(0)
  Dim As REAL d = c*c
  If (d > d2) Then Return 0
  c = a(1) - b(1)
  d += c*c
  If (d > d2) Then Return 0
  c = a(2) - b(2)
  d += c*c
  If (d > d2) Then Return 0
  gDist2 = d2
  Return 1
End Function


Sub RaySphere(idx As Integer,r() As REAL, o() As REAL)
  Dim As REAL s(2)
  SubVec(s,gSphere,o)
  Dim As REAL radius = gSphere(3)
  Dim As REAL A = DotProduct(r,r)
  Dim As REAL B = -2.0 * DotProduct(s,r)
  Dim As REAL C = DotProduct(s,s) - (radius*radius)
  Dim As REAL D = B*B - 4*A*C
  If (D < 0.0) Then Return
  Dim As REAL sign  = IIf(C < -0.00001,1,-1)
  Dim As REAL l = (-B + sign*Sqr(D))/(2*A)
  If (l<0) Or (l>gDist) Then Return
  gType  = 0
  gIndex = idx
  gDist  = l
  gIntersect = 1
End Sub


Sub RayPlane(idx As Integer, r() As REAL,o() As REAL)
  Dim As Integer axis = gPlanes(idx,0)
  If r(axis)=0 Then Return
  Dim As REAL l = (gPlanes(idx,1) - o(axis)) / r(axis)
  If (l<0) Or (l>gDist) Then Return
  gType  = 1
  gIndex = idx
  gDist  = l
  gIntersect = 1 
End Sub


Sub RayObject(typ As Integer, idx As Integer, r()As REAL, o() As REAL)
  If (typ = 0) Then
    RaySphere(idx,r(),o())
  Else
    RayPlane(idx,r(),o())
  End If
End Sub


Sub SphereNormal(r() As REAL,P() As REAL)
  Dim As REAL v(2)
  SubVec(v,P,gSphere)
  NormalizeVec(r,v)
End Sub


Sub PlaneNormal(r() As REAL, idx As Integer, P() As REAL, O() As REAL)
  Dim As Integer axis = gPlanes(idx,0)
  Dim As REAL N(2)
  N(axis) = O(axis) - gPlanes(idx,1)
  NormalizeVec(r,N)
End Sub


Sub SurfaceNormal(r() As REAL, _
                  typ As Integer, _
                  idx As Integer, _
                  P() As REAL, _
                  Inside() As REAL)
  If (typ = 0) Then
    SphereNormal(r(),P())
  Else
    PlaneNormal(r(),idx,P(),Inside())
  End If
End Sub


Sub MirrorVec(Ret() As REAL,_
              Ray() As REAL, _
              FromPoint() As REAL)
  Dim As REAL N(2)=Any,tmp(2)=Any
  SurfaceNormal(N(),gType, gIndex, gPoint(), fromPoint())
  MulScalarVec(tmp,N,(2 * DotProduct(ray,N) ))
  SubVec(tmp,ray,tmp)
  NormalizeVec(Ret,tmp)
End Sub


'
' Освещение
'
Function LightDiffuse(N() As REAL,P() As REAL) As REAL
  Dim As REAL L(2)=Any
  SubVec(L,gLight,P)
  NormalizeVec(L,L)
  Return DotProduct(N,L)
End Function


Function LightObject(typ As Integer, _
                     idx As Integer, _
                     P() As REAL, _
                     Ambient As REAL ) As REAL
  Dim As REAL N(2)=Any
  SurfaceNormal(N(),typ, idx, P(), gLight())
  Dim As REAL L = LightDiffuse(N() , P() )
  Return min(1.0, max(L, Ambient))
End Function


'
' Рейтрейсинг (трассировка лучей)
'
Sub Raytrace(ray() As REAL,origin() As REAL)
  gIntersect = 0
  gDist      = 999999.9
  For typ As Integer = 0 To Types-1
    For idx As Integer = 0 To Objects(typ)-1
      RayObject(typ,idx,ray(),origin())
    Next idx
  Next typ
End Sub


Sub AbsorbColor(ret() As REAL, _
                rgbIn() As REAL, _
                r As REAL,g As REAL,b As REAL) ' e.g. White Light Hits Red Wall
  Dim As REAL rgbOut(2)={r,g,b}
  For c As Integer =0 To 2
    ret(c) = min(rgbOut(c),rgbIn(c))
  Next
End Sub


Sub GetColor(r() As REAL, _
            rgbIn() As REAL, _
            typ As Integer, _
            idx As Integer)
  If (typ=0) Then     ' сфера
    AbsorbColor(r(),rgbIn(), 1, 1, 0.5)
  ElseIf (typ=1) Then ' плоскость
    If idx=0 Then
      AbsorbColor(r(),rgbIn(), 1.0, 0, 0)
    ElseIf idx=2 Then
      AbsorbColor(r(),rgbIn(), 0, 1.0, 0)
    Else 
      AbsorbColor(r(),rgbIn(), 1, 1, 1)
    End If
  End If
End Sub


Sub ComputePixelColor(prgb() As REAL,x As REAL,y As REAL)
  Dim As REAL ray(2) = {  x/Dimension - 0.5 , _
                          -(y/Dimension - 0.5), _
                                          1.0}
  Raytrace(ray(), gOrigin())
  If (gIntersect)  Then
    MulScalarVec(gPoint,ray,gDist)
    If (gType = 0) Then
      MirrorVec(ray(),ray(),gOrigin())
      Raytrace(ray(), gPoint())
      If (gIntersect) Then
        Dim As REAL tmp(2)=Any
        MulScalarVec(tmp,ray,gDist)
        AddVec(gPoint,tmp,gPoint)
      End If
    End If
 
    If (gPhotonMapping) Then
      GatherPhotons(prgb(),gPoint(),gType,gIndex)
    Else
      Dim As Integer tType  = gType
      Dim As Integer tIndex = gIndex
      Dim As REAL a = gAmbient
      Dim As REAL tmp(2)=Any
      SubVec(tmp,gPoint,gLight)
      Raytrace(tmp(),gLight())
      If (tType = gType) And (tIndex = gIndex) Then
        a = LightObject(gType, gIndex, gPoint(), gAmbient)
      End If
      prgb(0)=a:prgb(1)=a:prgb(2)=a
      GetColor(prgb(),prgb(),tType,tIndex)
    End If
  End If
End Sub


'
' Фотонный маппинг
'
Sub GatherPhotons(energy() As REAL, _
                  p() As REAL, _
                  typ As Integer, _
                  idx As Integer)
  Dim As REAL N(2)=Any
  Dim As REAL tmp(2)=Any
  Dim As REAL g(2)=Any
  Dim As REAL weight=Any
  Dim As REAL frgb(2)=Any
  SurfaceNormal(N(), typ, idx, p(), gOrigin())


  For i As Integer = 0  To  NumberOfPhotons(typ,idx)-1
    ' положение
    g(0)=gPhotons(typ,idx,i,0,0)
    g(1)=gPhotons(typ,idx,i,0,1)
    g(2)=gPhotons(typ,idx,i,0,2)
    If (Distance2(p(),g(),gRadius2)) Then
      ' направление
      g(0)=gPhotons(typ,idx,i,1,0)
      g(1)=gPhotons(typ,idx,i,1,1)
      g(2)=gPhotons(typ,idx,i,1,2)
      weight = max(0.0, -DotProduct(N,g) )
      weight *= (1.0 - Sqr(gDist2)) / gExposure
      ' энергия
      g(0)=gPhotons(typ,idx,i,2,0)
      g(1)=gPhotons(typ,idx,i,2,1)
      g(2)=gPhotons(typ,idx,i,2,2)
      MulScalarVec(tmp,g,weight)
      AddVec(frgb,frgb,tmp)
    End If
  Next i
  For j As Integer=0 To 2
    energy(j)=max(0,min(1,frgb(j) ) )
  Next j
End Sub


Sub EmitPhotons
  Randomize 1
  Dim As REAL frgb(2)=Any
  Dim As REAL ray(2)=Any
  Dim As REAL p(2)=Any
  For typ As Integer = 0 To Types-1
    For idx As Integer = 0 To Objects(typ)-1
      NumberOfPhotons(typ,idx) = 0
    Next idx
  Next typ
  For i As Integer = 0 To MaxPhotons-1
    Dim As Integer bounces = 1
    ' белый цвет фотона
    frgb(0)=1:frgb(1)=1:frgb(2)=1
    RandomVec(ray)
    NormalizeVec(ray,ray)
    p(0) = gLight(0)
    p(1) = gLight(1)
    p(2) = gLight(2)
    While (p(1) >= gLight(1))
      Dim As REAL N(2)=Any
      RandomVec(N)
      NormalizeVec(N,N)
      MulScalarVec(N,N,0.75)
      AddVec(p,gLight,N)
    Wend
   
    Raytrace(ray(), p())
       
    If Abs(p(0) > 1.5) Then Continue For
    If Abs(p(1) > 1.5) Then  Continue For
    If Distance2(p(), gSphere(),gSphere(3)*gSphere(3)) Then  Continue For
    While (gIntersect<>0) And (bounces <= MaxRelections)
      Dim As REAL tmp(2)=Any
      MulScalarVec(tmp,ray,gDist)
      AddVec(gPoint, tmp, p)
      GetColor(frgb(),frgb(),gType,gIndex)
      MulScalarVec(frgb,frgb, 1.0/Sqr(bounces))
      StorePhoton(gType, gIndex, gPoint(), ray(),frgb())
      DrawPhoton(frgb(), gPoint())
      ShadowPhoton(ray())
      MirrorVec(ray(),ray(),p())
      Raytrace(ray(), gPoint())
      p(0) = gPoint(0)
      p(1) = gPoint(1)
      p(2) = gPoint(2)
      bounces+=1
    Wend
  Next i
End Sub


Sub StorePhoton(typ As Integer, _
                idx As Integer, _
                l() As REAL,_
                d() As REAL, _
                e() As REAL)
  Dim As Integer Photon=NumberOfPhotons(typ,idx)
  For i As Integer=0 To 2
    gPhotons(typ,idx,Photon,0,i) = l(i) ' Положение
    gPhotons(typ,idx,Photon,1,i) = d(i) ' Направление
    gPhotons(typ,idx,Photon,2,i) = e(i) ' Энергия
  Next
  NumberOfPhotons(typ,idx)=Photon+1
End Sub


Sub ShadowPhoton(ray() As REAL)
  Dim As REAL shadow(2) = {-0.25,-0.25,-0.25}
  Dim As REAL tPoint(2) = {gPoint(0), gPoint(1),gPoint(2)}
  Dim As Integer tType  = gType ' Save State
  Dim As Integer tIndex = gIndex
  Dim As REAL BumpedPoint(2)
  MulScalarVec(BumpedPoint,ray,0.000001)
  AddVec(BumpedPoint,gPoint,BumpedPoint)
  Raytrace(ray(), BumpedPoint())
  Dim As REAL ShadowPoint(2)=Any
  MulScalarVec(ShadowPoint,ray,gDist)
  AddVec(ShadowPoint,ShadowPoint, BumpedPoint) ' 3D точка
  StorePhoton(gType, gIndex, ShadowPoint(), ray(), shadow())
  gPoint(0) = tPoint(0)
  gPoint(1) = tPoint(1)
  gPoint(2) = tPoint(2)
  gType  = tType
  gIndex = tIndex
End Sub


'
' Рендеринг (визуализация)
'
Sub Render
  Dim As Integer x,y,iterations = 0
  Dim As Integer nruns
  nruns=256
  While (iterations < nruns)
    nruns=max(pMax, 256)
    If (pCol >= pMax) Then
      pRow+=1
      pCol = 0
      If (pRow >= pMax) Then
        pIteration+=1
        pRow = 0
        pMax = Int(2^pIteration)
      End If
    End If
    Dim As Integer pNeedsDrawing = (pIteration = 1) Or odd(pRow) _
                                 Or ( (odd(pRow)=0) And odd(pCol))
    x = pCol * (Dimension/pMax)
    y = pRow * (Dimension/pMax)
   
    pCol+=1
   
    If (pNeedsDrawing) Then
      iterations+=1
      Dim As REAL b(2)
      ComputePixelColor(b(),x,y)
      Dim As UInteger col=RGB(b(0)*255,b(1)*255,b(2)*255)
      Line (x,y)-Step((Dimension/pMax)-1,(Dimension/pMax)-1),col,BF ' Возможность отрисовки увеличенного пикселя
      'pset (x,y),col
    End If
  Wend
  If (pRow = Dimension-1) Then
    gEmpty = 0
  End If
End Sub


Sub ResetRender()
  pRow=0
  pCol=0
  pIteration=1
  pMax=2
  gEmpty=1
  If (gPhotonMapping And Not gView3D) Then
    EmitPhotons()
  End If
End Sub




Sub setup()
  ScreenRes Dimension,Dimension,24
  ResetRender
End Sub


Sub drawit()
  If gPhotonMapping Then
    WindowTitle "[1]Рейтрейсинг [3]Просмотр фотонов"
  Else
    WindowTitle "[2]Фотонная карта [3]Просмотр фотонов"
  End If
  If (gView3D) Then
    If (gEmpty) Then
      Cls
      EmitPhotons()
      gEmpty = 0
    End If
  Else
    If (gEmpty) Then
      Render()
    End If
  End If
End Sub


Sub DrawPhoton(frgb() As REAL,p() As REAL)
  If (gView3D=1) And Int(p(2) > 0.0) Then
    Dim As Integer x = (Dimension/2) + Int(Dimension *  p(0)/p(2))
    Dim As Integer y = (Dimension/2) + Int(Dimension * -p(1)/p(2))
    If (y <= Dimension) Then
      PSet (x,y),RGB(frgb(0)*255,frgb(1)*255,frgb(2)*255)
    End If
  End If
End Sub


Sub SwitchToMode(i As String)
  If (i="1") Then
    gView3D = 0
    gPhotonMapping = 0
    ResetRender()
  ElseIf (i="2") Then
    gView3D = 0
    gPhotonMapping = 1 
    ResetRender()
  ElseIf (i="3") Then
    gView3D = 1
    ResetRender()
  End If
End Sub


'
' Основная программа
'
Dim As String key ' Переменная символа нажатой клавиши
setup() ' Установка размеров окна и сброс рендера
While key<>Chr(27) ' Выполняет программу пока не нажата клавиша Esc
  key=InKey
  If key="1" Or key="2" Or key="3" Then
    SwitchToMode(key) ' Сброс рендера и переключение в режим отображения по символу нажатой клавиши
    key=""
  End If 
  drawit() ' Отрисовка заголовка окна и рендер 256 пикселей
  Sleep(100) ' Пауза 100 миллисекунд
Wend
« Последнее редактирование: 18 Августа 2016, 13:43:42 от Samovar »
¯\_(ツ)_/¯

Оффлайн Samovar

  • Житель
  • Пятигорье
Re: Рейтрейсер на FB (FreeBasic)
« Ответ #12 : 18 Августа 2016, 21:48:48 »
Нашёл более понятную статью по векторам в компьютерной графике: https://habrahabr.ru/post/131931/
¯\_(ツ)_/¯

Оффлайн LanuHum

  • Житель
Re: Рейтрейсер на FB (FreeBasic)
« Ответ #13 : 11 Декабря 2016, 10:13:47 »
Samovar, ну ты разобрался, как из питона запускать код на бейсике?
Тогда ты бы смог замутить постобработку интерналовской картинки, дорисовывающую каустику.

Оффлайн Samovar

  • Житель
  • Пятигорье
Re: Рейтрейсер на FB (FreeBasic)
« Ответ #14 : 11 Декабря 2016, 10:43:41 »
Пока не разобрался... :(  Сначала заморочался на историю с Дедом Морозом... потом на освещение в интерьере...
Ланухумыч, уточную - машинный код, а каким образом он был скомпилирован, с помощью Ассемблера,  Си, FB или Delphi (Паскаль) и т.д. это пофиг...
« Последнее редактирование: 11 Декабря 2016, 11:36:48 от Samovar »
¯\_(ツ)_/¯

 


* По форуму

* Последние вложения

Слежение.jpg
Скачано: 6
Автор: Barabashka
vvv.png
Скачано: 64
Автор: Николай Николаев
Слежение.jpg
Скачано: 13
Автор: Barabashka
mehanizm-dlya-podemnoy-krovati-mkb-l633670.jpg
Скачано: 22
Автор: СемёнСемёныч
Безымянный.jpg
Скачано: 21
Автор: СемёнСемёныч