Please read the window title (or Init() in the code) for info how to interact with the program. (cursor left/right to change the tip)
If you encounter any problems I'd be happy to hear about it, and try to fix it.
Btw., take a close look at those surfaces (bumps on the ground, wood grain on top of the rings, weathering of the blue sphere, organic color variation on the white of the eyes), that's all computed on the fly per pixel using PB, no precomputed textures used.
Edit: reduced noise/artifacts
Code: Select all
; Experiments In Ray Tracing 4
; Frameless rendering, better lighting, gamma correction, realtime perlin noise almost everywhere, virtual camera/monitor,...
; PB 5.42, done on Windows7 64bit
; Hades, 2016
CompilerIf #PB_Compiler_Thread = 0
MessageRequester( "Sorry...", "Please, set Compiler/Compiler Options... to threadsafe before compiling" )
End
CompilerEndIf
EnableExplicit
DisableDebugger
#TileSize = 64
#MaxDist = 1000000
#FpError = 0.01
Structure Vec3
x.f : y.f : z.f
EndStructure
Structure Matrix
m.f[16]
EndStructure
Structure Color
r.f : g.f : b.f
EndStructure
Structure Material
DiffuseColor.Color
SpecularIntensity.f
Glossiness.f
AmbientIntensity.f
Reflectance.f
Transmittance.f
IndexOfRefraction.f
Shader.i
pShaderData.i
EndStructure
Global NewList Material.Material()
Structure Light
Direction.Vec3
Color.Color
k.f
EndStructure
Global Light.Light
Global Sky.Color
Structure Ray
Origin.Vec3
Direction.Vec3
rDirection.Vec3
length.f
PrimitiveHit.i
Weight.f
Col.Color
inside.i
EndStructure
Global PrimRayOffX.Vec3
Global PrimRayOffY.Vec3
Structure Sphere
Position.Vec3
Radius.f
*Material.Material
EndStructure
Global NewList Sphere.Sphere()
Global Dim SphereX.f(15)
Global Dim SphereY.f(15)
Global Dim SphereZ.f(15)
Global Dim SphereRadius.f(15)
Global Dim *SphereMaterial.Material(15)
Structure Camera
Pos.Vec3
Matrix.Matrix
VScrTL.Vec3
VScrR.Vec3
VScrB.Vec3
PixOffsX.Vec3
PixOffsY.Vec3
EndStructure
Global Camera.Camera
Structure RayPattern
px.i
py.i
Buffer.i
EndStructure
Global Dim RayPattern.RayPattern(#TileSize * #TileSize - 1)
Global Dim PixelPattern.i(255)
Structure Job
x.i
y.i
Offset.i
Error.f
EndStructure
Global Dim Job.Job(0)
Global numJobs
Global JobIdx
Global mutJob
Global Density
mutJob = CreateMutex()
Global Dim PNPermut.i(256)
Global Dim PNGradient.f(256)
Structure Display
hdc.i
hrc.i
WindowNr.i
DisplList.i
pBuffer.i
BufferWidth.i
BufferHeight.i
BufferPitch.i
RenderWidth.i
RenderHeight.i
VisibleWidth.i
VisibleHeight.i
RenderQuality.i
Resolution.i
Sampling.i
SoftShadow.i
EndStructure
Global Display.Display
Global Dim GammaLUT.i(8192)
Structure Main
Running.i
Time.i
AvTime.f
InfoTime.i
NumThreads.i
FlipTime.i
FlipTarget.i
Material_Default.i
Material_Background.i
Shader_Default.i
MouseLook.i
MouseX.i
MouseY.i
RotX.f
RotY.f
Moved.i
ViewDir.Vec3
Speed.f
MovFwd.f
MovSide.f
MovUpDown.f
Eye.i
EndStructure
Global Main.Main
Global NewList Info.s()
Global Dim KeyDown(255)
Global KeyControl.i
Structure EyeCam
Pos.Vec3
Dir.Vec3
RotX.f
RotY.f
Mat.Matrix
EndStructure
Global Dim EyeCam.EyeCam(3)
Global Dim EyeCamNxt.EyeCam(3)
Macro mColorSet(Color, cr, cg, cb)
Color\r = cr
Color\g = cg
Color\b = cb
EndMacro
Macro mVectorSet(Vector, VX, VY, VZ)
Vector\x = VX
Vector\y = VY
Vector\z = VZ
EndMacro
Macro mNormalize(Vector, rLength)
rLength = 1.0 / Sqr(Vector\x * Vector\x + Vector\y * Vector\y + Vector\z * Vector\z)
Vector\x * rLength
Vector\y * rLength
Vector\z * rLength
EndMacro
Macro mCross(ResultVec, Vec1, Vec2)
ResultVec\x = Vec1\y * Vec2\z - Vec1\z * Vec2\y
ResultVec\y = Vec1\z * Vec2\x - Vec1\x * Vec2\z
ResultVec\z = Vec1\x * Vec2\y - Vec1\y * Vec2\x
EndMacro
Macro mClamp(x, a, b)
If x < a
x = a
ElseIf x > b
x = b
EndIf
EndMacro
Macro mSmoothstep(Edge0, Edge1, x)
x = (x - Edge0) / (Edge1 - Edge0)
mClamp(x, 0.0, 1.0)
x * x * (3 - 2 * x)
EndMacro
Declare Shade(*Ray.Ray, Depth.i)
Procedure.f Noise2d(x.f, y.f)
Protected xi.i, yi.i, xl.i, yl.i, v00.f, v01.f, v10.f, v11.f, v0.f, v1.f
xi = Round(x, #PB_Round_Down) : yi = Round(y, #PB_Round_Down)
x - xi : y - yi
v00 = PNGradient((xi + PNPermut(yi & 255)) & 255)
v01 = PNGradient((xi + 1 + PNPermut(yi & 255)) & 255)
v10 = PNGradient((xi + PNPermut((yi + 1) & 255)) & 255)
v11 = PNGradient((xi + 1 + PNPermut((yi + 1) & 255)) & 255)
v0 = v00 * (1.0 - x) + v01 * x
v1 = v10 * (1.0 - x) + v11 * x
ProcedureReturn v0 * (1.0 - y) + v1 * y
EndProcedure
Procedure MatrixIdentity(*Matrix.Matrix)
*Matrix\m[0] = 1.0 : *Matrix\m[1] = 0.0 : *Matrix\m[2] = 0.0 : *Matrix\m[3] = 0.0
*Matrix\m[4] = 0.0 : *Matrix\m[5] = 1.0 : *Matrix\m[6] = 0.0 : *Matrix\m[7] = 0.0
*Matrix\m[8] = 0.0 : *Matrix\m[9] = 0.0 : *Matrix\m[10] = 1.0 : *Matrix\m[11] = 0.0
*Matrix\m[12] = 0.0 : *Matrix\m[13] = 0.0 : *Matrix\m[14] = 0.0 : *Matrix\m[15] = 1.0
EndProcedure
Procedure MatrixVec3Rotation(*Result.Vec3, *Vector.Vec3, *Matrix.Matrix)
Protected TempX.f, TempY.f
TempX = *Matrix\m[0] * *Vector\x + *Matrix\m[1] * *Vector\y + *Matrix\m[2] * *Vector\z
TempY = *Matrix\m[4] * *Vector\x + *Matrix\m[5] * *Vector\y + *Matrix\m[6] * *Vector\z
*Result\z = *Matrix\m[8] * *Vector\x + *Matrix\m[9] * *Vector\y + *Matrix\m[10] * *Vector\z
*Result\x = TempX
*Result\y = TempY
EndProcedure
Procedure MatrixRotateX(*Matrix.Matrix, Angle.f)
Protected Help.f, tsin.f, tcos.f
tsin = Sin(Angle) : tcos = Cos(Angle)
Help = *Matrix\m[4] * tcos + *Matrix\m[8] * tsin
*Matrix\m[8] = *Matrix\m[4] * -tsin + *Matrix\m[8] * tcos
*Matrix\m[4] = Help
Help = *Matrix\m[5] * tcos + *Matrix\m[9] * tsin
*Matrix\m[9] = *Matrix\m[5] * -tsin + *Matrix\m[9] * tcos
*Matrix\m[5] = Help
Help = *Matrix\m[6] * tcos + *Matrix\m[10] * tsin
*Matrix\m[10] = *Matrix\m[6] * -tsin + *Matrix\m[10] * tcos
*Matrix\m[6] = Help
EndProcedure
Procedure MatrixRotateY(*Matrix.Matrix, Angle.f)
Protected Help.f, tsin.f, tcos.f
tsin = Sin(Angle) : tcos = Cos(Angle)
Help = *Matrix\m[0] * tcos - *Matrix\m[8] * tsin
*Matrix\m[8] = *Matrix\m[0] * tsin + *Matrix\m[8] * tcos
*Matrix\m[0] = Help
Help = *Matrix\m[1] * tcos - *Matrix\m[9] * tsin
*Matrix\m[9] = *Matrix\m[1] * tsin + *Matrix\m[9] * tcos
*Matrix\m[1] = Help
Help = *Matrix\m[2] * tcos - *Matrix\m[10] * tsin
*Matrix\m[10] = *Matrix\m[2] * tsin + *Matrix\m[10] * tcos
*Matrix\m[2] = Help
EndProcedure
Procedure.f StepFunc(a.f, x.f)
If x > a
ProcedureReturn 1.0
EndIf
ProcedureReturn 0.0
EndProcedure
Procedure SphereCreate(x.f, y.f, z.f, radius.f, *Material.Material)
AddElement(Sphere())
mVectorSet(Sphere()\Position, x, y, z)
Sphere()\radius = radius
Sphere()\Material = *Material
EndProcedure
Procedure.i RTMaterialCreate(r.f = 1.0, g.f = 1.0, b.f = 1.0, Shader.i = 0)
If Shader = 0
Shader = Main\Shader_Default
EndIf
AddElement(Material())
mColorSet(Material()\DiffuseColor, r, g, b)
Material()\SpecularIntensity = 0.2
Material()\Glossiness = 20
Material()\AmbientIntensity = 0.1
Material()\Reflectance = 0.0
Material()\Transmittance = 0.0
Material()\IndexOfRefraction = 1.0
Material()\Shader = Shader
ProcedureReturn @Material()
EndProcedure
Procedure RTCameraUpdate()
Protected Cam.Camera
Cam = Camera
mVectorSet(Cam\VScrTL, 0.5 -0.5 * Display\RenderWidth, 0.5 + 0.5 * Display\RenderHeight, Display\RenderWidth)
mVectorSet(Cam\VScrB, 0.5 -0.5 * Display\RenderWidth, 0.5 -0.5 * Display\RenderHeight, Display\RenderWidth)
mVectorSet(Cam\VScrR, 0.5 + 0.5 * Display\RenderWidth, 0.5 + 0.5 * Display\RenderHeight, Display\RenderWidth)
MatrixVec3Rotation(Cam\VScrTL, Cam\VScrTL, Cam\Matrix)
MatrixVec3Rotation(Cam\VScrB, Cam\VScrB, Cam\Matrix)
MatrixVec3Rotation(Cam\VScrR, Cam\VScrR, Cam\Matrix)
mVectorSet(Cam\PixOffsX, (Cam\VScrR\x - Cam\VScrTL\x) / Display\RenderWidth, (Cam\VScrR\y - Cam\VScrTL\y) / Display\RenderWidth, (Cam\VScrR\z - Cam\VScrTL\z) / Display\RenderWidth)
mVectorSet(Cam\PixOffsY, (Cam\VScrB\x - Cam\VScrTL\x) / Display\RenderHeight, (Cam\VScrB\y - Cam\VScrTL\y) / Display\RenderHeight, (Cam\VScrB\z - Cam\VScrTL\z) / Display\RenderHeight)
Camera = Cam
EndProcedure
Procedure InitRayPattern()
Protected x.i, y.i, px.i, i.i
For y = 0 To #TileSize - 1
For x = 0 To #TileSize - 1
px = (x & $FFF0) + PixelPattern((x + y * 16) & 255)
RayPattern(i)\px = px
RayPattern(i)\py = y
RayPattern(i)\Buffer = px * 4 + y * Display\BufferPitch
i + 1
Next
Next
EndProcedure
Procedure DisplayBufferInit(VisibleWidth.i, VisibleHeight.i)
Protected pExtensions.i, Extensions.s
Static Tex.i
If Display\pBuffer
FreeMemory(Display\pBuffer)
EndIf
Display\VisibleWidth = VisibleWidth : Display\VisibleHeight = VisibleHeight
Display\RenderWidth = 1280 : Display\RenderHeight = 768
If Display\Resolution = 0
Display\RenderWidth = 640 : Display\RenderHeight = 384
ElseIf Display\Resolution = 2
Display\RenderWidth = 2560 : Display\RenderHeight = 1536
EndIf
Display\BufferWidth = Display\RenderWidth : Display\BufferHeight = Display\RenderHeight
Display\BufferPitch = (Display\BufferWidth + 2) * 4
Display\pBuffer = AllocateMemory(Display\BufferPitch * (Display\BufferHeight + 2))
glShadeModel_(#GL_FLAT)
glEnable_(#GL_TEXTURE_2D)
glBindTexture_(#GL_TEXTURE_2D, @Tex)
glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MAG_FILTER, #GL_LINEAR)
glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MIN_FILTER, #GL_LINEAR)
glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_WRAP_S, #GL_CLAMP)
glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_WRAP_T, #GL_CLAMP)
If Display\DisplList <> 0 : glDeleteLists_(Display\DisplList, 1) : EndIf
Display\DisplList = glGenLists_(1)
glNewList_(Display\DisplList, #GL_COMPILE)
glBegin_(#GL_QUADS)
glTexCoord2f_(0.0, 0.0)
glVertex2i_(0,0)
glTexCoord2f_(0.0, 1.0)
glVertex2i_(0, Display\VisibleHeight)
glTexCoord2f_(1.0, 1.0)
glVertex2i_(Display\VisibleWidth, Display\VisibleHeight)
glTexCoord2f_(1.0, 0.0)
glVertex2i_(Display\VisibleWidth, 0)
glEnd_()
glEndList_()
EndProcedure
Procedure glWindowOpen(Width.i, Height.i, Name.s = "Experiments In Ray Tracing 4", flags.i = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered | #PB_Window_Maximize)
numJobs = -1
Delay(200)
If IsWindow(0)
FreeGadget(0) : CloseWindow(0)
EndIf
OpenWindow(0, 0, 0, Width, Height, Name, flags)
Width = WindowWidth(0, #PB_Window_InnerCoordinate) : Height = WindowHeight(0, #PB_Window_InnerCoordinate)
OpenGLGadget(0, 0, 0, Width, Height, #PB_OpenGL_Keyboard | #PB_OpenGL_NoDepthBuffer | #PB_OpenGL_NoFlipSynchronization)
SetActiveGadget(0)
SetGadgetAttribute(0, #PB_OpenGL_FlipBuffers, #True)
glOrtho_(0.0, Width, Height, 0.0, 0.0, 1.0)
DisplayBufferInit(Width, Height)
InitRayPattern()
If Main\MouseLook
SetGadgetAttribute(0, #PB_OpenGL_Cursor, #PB_Cursor_Invisible)
SetGadgetAttribute(0, #PB_OpenGL_Cursor, #PB_Cursor_Invisible)
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
SetCursorPos_(WindowX(0) + WindowWidth(0) / 2, WindowY(0) + WindowHeight(0) / 2)
CompilerEndIf
EndIf
EndProcedure
Procedure DisplayBufferShow(pBuffer.i)
glEnable_(#GL_TEXTURE_2D)
glTexImage2D_(#GL_TEXTURE_2D, 0, #GL_RGBA, Display\BufferWidth + 2, Display\BufferHeight + 2, 0, #GL_BGRA_EXT, #GL_UNSIGNED_BYTE, pBuffer)
glCallList_(Display\DisplList)
SetGadgetAttribute(0, #PB_OpenGL_FlipBuffers, #True)
EndProcedure
Procedure Intersect_Spheres(*Ray.Ray)
Protected i.i, MaxD.f, t1.f, idx1, t2.f, idx2, *SphereX.float, *SphereY.float, *SphereZ.float, *SphereRadius.float
For i = 0 To 1
*SphereX.float = @SphereX(i * 4)
*SphereY.float = @SphereY(i * 4)
*SphereZ.float = @SphereZ(i * 4)
*SphereRadius.float = @SphereRadius(i * 4)
MaxD = #MaxDist
!mov edx, [p.p_Ray]
!movss xmm0, [edx] ; *Ray\Origin\x
!shufps xmm0, xmm0, 0
!movss xmm1, [edx + 4] ; *Ray\Origin\y
!shufps xmm1, xmm1, 0
!movss xmm2, [edx + 8] ; *Ray\Origin\z
!shufps xmm2, xmm2, 0
!mov eax, [p.p_SphereX]
!movups xmm5, [eax]
!subps xmm0, xmm5 ; RelPos\x = *Ray\Origin\x - *Sphere\Position\x
!mov ecx, [p.p_SphereY]
!movups xmm6, [ecx]
!subps xmm1, xmm6 ; RelPos\y = *Ray\Origin\y - *Sphere\Position\y
!mov eax, [p.p_SphereZ]
!movups xmm7, [eax]
!subps xmm2, xmm7 ; RelPos\z = *Ray\Origin\z - *Sphere\Position\z
!movss xmm3, [edx + 12] ; *Ray\Direction\x
!shufps xmm3, xmm3, 0
!movss xmm4, [edx + 16] ; *Ray\Direction\y
!shufps xmm4, xmm4, 0
!movss xmm5, [edx + 20] ; *Ray\Direction\z
!shufps xmm5, xmm5, 0
;b = *Ray\Direction\x * RelPos\x + *Ray\Direction\y * RelPos\y + *Ray\Direction\z * RelPos\z
!mulps xmm3, xmm0 ; *Ray\Direction\x * RelPos\x
!mulps xmm4, xmm1 ; *Ray\Direction\y * RelPos\y
!mulps xmm5, xmm2 ; *Ray\Direction\z * RelPos\z
!addps xmm3, xmm4
!addps xmm3, xmm5
;c = (RelPos\x * RelPos\x + RelPos\y * RelPos\y + RelPos\z * RelPos\z) - *Sphere\radius * *Sphere\radius
!mov edx, [p.p_SphereRadius]
!movups xmm7, [edx]
!mulps xmm7, xmm7 ; *Sphere\radius * *Sphere\radius
!mulps xmm0, xmm0 ; RelPos\x * RelPos\x
!mulps xmm1, xmm1 ; RelPos\y * RelPos\y
!mulps xmm2, xmm2 ; RelPos\z * RelPos\z
!addps xmm0, xmm1
!addps xmm0, xmm2
!subps xmm0, xmm7
;d = b * b - c
!movaps xmm4, xmm3
!mulps xmm4, xmm4
!subps xmm4, xmm0
; setting everything below 0.0 to 0.0, to not cause trouble with sqrt
!xorps xmm6, xmm6 ; all 0.0
!maxps xmm4, xmm6
!sqrtps xmm4, xmm4 ; d = sqr(d)
; b = -b
!pcmpeqw xmm7, xmm7 ; all bits to 1
!pslld xmm7, 31 ; only sign bits set
!xorps xmm3, xmm7 ; flip sign bits
; There are two intersections with a sphere possible: t1 = b - d and t2 = b + d
!movaps xmm1, xmm3
!subps xmm3, xmm4 ; t1 = b - d
!addps xmm1, xmm4 ; t2 = b + d
; set t1 to #MaxDist if d <= 0.0 or t1 <= 0.0, so no hit will be detected, to avoid conditonals
!movss xmm7, [p.v_MaxD] ; load #MaxDist
!shufps xmm7, xmm7, 0
!cmpps xmm4, xmm6, 2 ; create mask d <= 0
!movaps xmm0, xmm3
!cmpps xmm0, xmm6, 2 ; create mask t1 <= 0
!orps xmm0, xmm4 ; combine
!movaps xmm2, xmm0 ; t = #MaxDist for d <= 0 or t1 <= 0
!movaps xmm5, xmm3
!andps xmm7, xmm2
!andnps xmm2, xmm5
!orps xmm7, xmm2
!movaps xmm3, xmm7
; find closest hit
!movaps xmm5, xmm3
!movaps xmm0, xmm3
!shufps xmm0, xmm5, 01001110b ; shuffle to 1032
!minps xmm5, xmm0
!movaps xmm2, xmm5
!shufps xmm5, xmm5, 10110001b ; shuffle to 2301
!minps xmm5, xmm2 ; now smallest t1 is in all positions
!movss [p.v_t1], xmm5 ; store closest hit
!cmpeqps xmm5, xmm3 ; set mask for smallest t1 in original
!movmskps eax, xmm5 ; move sign to rax
!bsf eax, eax ; turn sign into index
!mov [p.v_idx1], eax ; store index of closest hit
If t1 < *Ray\length
*Ray\length = t1
*Ray\PrimitiveHit = i * 4 + idx1
EndIf
Next i
EndProcedure
Procedure.f Shadow(*ShadowRay.Ray, *Normal.Vec3, *LightDirection.Vec3, LightDistance.f)
Protected RelPos.Vec3, b.f, c.f, d.f, lv.f, i.i, l.f
l = 1.0
If Display\RenderQuality > 1
mVectorSet(*ShadowRay\Direction, *LightDirection\x, *LightDirection\y, *LightDirection\z)
*ShadowRay\length = LightDistance
Intersect_Spheres(*ShadowRay)
If *ShadowRay\PrimitiveHit < 0.0
ProcedureReturn 1.0
ElseIf Display\SoftShadow = 0
ProcedureReturn 0.0
EndIf
; check for partitial shadowing
i = *ShadowRay\PrimitiveHit
mVectorSet(RelPos, *ShadowRay\Origin\x - SphereX(i), *ShadowRay\Origin\y - SphereY(i), *ShadowRay\Origin\z - SphereZ(i))
b = *ShadowRay\Direction\x * RelPos\x + *ShadowRay\Direction\y * RelPos\y + *ShadowRay\Direction\z * RelPos\z
c = (RelPos\x * RelPos\x + RelPos\y * RelPos\y + RelPos\z * RelPos\z) - SphereRadius(i) * SphereRadius(i)
d = b * b - c
lv = 1.0 - Light\k * d / (SphereRadius(i) * -b)
mSmoothstep(0.0, 1.0, lv)
If lv <= 0.0 ; full shadow
ProcedureReturn lv
EndIf
; when we have partitial shadow we have to check everything in the path to avoid light leaks
For i = 0 To 7
mVectorSet(RelPos, *ShadowRay\Origin\x - SphereX(i), *ShadowRay\Origin\y - SphereY(i), *ShadowRay\Origin\z - SphereZ(i))
b = *ShadowRay\Direction\x * RelPos\x + *ShadowRay\Direction\y * RelPos\y + *ShadowRay\Direction\z * RelPos\z
c = (RelPos\x * RelPos\x + RelPos\y * RelPos\y + RelPos\z * RelPos\z) - SphereRadius(i) * SphereRadius(i)
If b < 0.0
d = b * b - c
If d > 0.0
lv = 1.0 - Light\k * d / (SphereRadius(i) * -b)
mSmoothstep(0.0, 1.0, lv)
If lv < l
l = lv
If l <= 0.0 ; full shadow
l = 0.0
Break
EndIf
EndIf
EndIf
EndIf
Next i
EndIf
ProcedureReturn l
EndProcedure
Procedure GetSphereNormal(SphIdx.i, *Ray.Ray, *HitPosition.Vec3, *Normal.Vec3)
Protected rLength.f
mVectorSet(*Normal, *HitPosition\x - SphereX(SphIdx), *HitPosition\y - SphereY(SphIdx), *HitPosition\z - SphereZ(SphIdx))
mNormalize(*Normal, rLength.f)
If *Ray\inside
mVectorSet(*Normal, -*Normal\x, -*Normal\y, -*Normal\z)
EndIf
EndProcedure
Procedure GetLightSpecularColor(*Ray.Ray, *Light.Light, *Normal.Vec3, *LightDirection.Vec3, LightNormalAngle.f, *LightSpecularColor.Color, L.f)
Protected Angle.f, ReflectedLightVector.Vec3, Intensity.f, *Material.Material
*Material = *SphereMaterial(*Ray\PrimitiveHit)
Angle = 2.0 * LightNormalAngle
mVectorSet(ReflectedLightVector, *LightDirection\x - Angle * *Normal\x, *LightDirection\y - Angle * *Normal\y, *LightDirection\z - Angle * *Normal\z)
Angle = *Ray\Direction\x * ReflectedLightVector\x + *Ray\Direction\y * ReflectedLightVector\y + *Ray\Direction\z * ReflectedLightVector\z
If Angle > 0.5
Intensity = *Material\SpecularIntensity * Pow(Angle, *Material\Glossiness)
mColorSet(*LightSpecularColor, L * Intensity * Light\Color\r, L * Intensity * Light\Color\g, L * Intensity * Light\Color\b)
EndIf
EndProcedure
Procedure GetLight(*Ray.Ray, *HitPosition.Vec3, *Normal.Vec3, *LightDiffuseColor.Color, *LightSpecularColor.Color)
Protected i.i, LightNormalAngle.f, LightDistance.f, ShadowRay.Ray, *Material.Material, SkyIntens.f, L.f, v.f
*Material = *SphereMaterial(*Ray\PrimitiveHit)
LightDistance = #MaxDist
LightNormalAngle = *Normal\x * Light\Direction\x + *Normal\y * Light\Direction\y + *Normal\z * Light\Direction\z
If Not *Ray\inside : SkyIntens = 0.5 + 0.5 * *Normal\y : EndIf
If LightNormalAngle > 0.0
mVectorSet(ShadowRay\Origin, *HitPosition\x + #FpError * *Normal\x, *HitPosition\y + #FpError * *Normal\y, *HitPosition\z + #FpError * *Normal\z)
ShadowRay\PrimitiveHit = -1
L = Shadow(@ShadowRay, *Normal, Light\Direction, LightDistance)
If ShadowRay\PrimitiveHit >= 0
v = 0.08 * ShadowRay\length
mClamp(v, 0.0, 1.0)
SkyIntens * v
EndIf
If L > 0.0 And Not *Ray\inside
mColorSet(*LightDiffuseColor, L * LightNormalAngle * Light\Color\r, L * LightNormalAngle * Light\Color\g, L * LightNormalAngle * Light\Color\b)
If *SphereMaterial(*Ray\PrimitiveHit)\SpecularIntensity > 0.0
GetLightSpecularColor(*Ray, Light, *Normal, Light\Direction, LightNormalAngle, *LightSpecularColor, L)
EndIf
EndIf
EndIf
mColorSet(*LightDiffuseColor, *LightDiffuseColor\r + Sky\r * SkyIntens, *LightDiffuseColor\g + Sky\g * SkyIntens, *LightDiffuseColor\b + Sky\b * SkyIntens)
EndProcedure
Procedure ReflectTransmit(*Ray.Ray, *HitPosition.Vec3, *Material.Material, *Normal.Vec3, Depth.i)
Protected Angle.f, RayNormalAngle.f, Fresnel.f, rRay.Ray, OutsideIoR.f, RelativeIoR.f, SinT2.f, v.f
If Depth < 50 And Display\RenderQuality > 1
If *Material\Reflectance > 0.0
RayNormalAngle = (*Ray\Direction\x * *Normal\x + *Ray\Direction\y * *Normal\y + *Ray\Direction\z * *Normal\z)
Fresnel = Pow((1.0 + RayNormalAngle), 5.0)
rRay\Weight = *Ray\Weight * (*Material\Reflectance + (1 - *Material\Reflectance) * Fresnel)
*Ray\Weight * (1.0-(*Material\Reflectance + (1 - *Material\Reflectance) * Fresnel))
If rRay\Weight > 0.003
mVectorSet(rRay\Origin, *HitPosition\x + #FpError * *Normal\x, *HitPosition\y + #FpError * *Normal\y, *HitPosition\z + #FpError * *Normal\z)
Angle = 2.0 * (*Ray\Direction\x * *Normal\x + *Ray\Direction\y * *Normal\y + *Ray\Direction\z * *Normal\z)
mVectorSet(rRay\Direction, *Ray\Direction\x - Angle * *Normal\x, *Ray\Direction\y - Angle * *Normal\y, *Ray\Direction\z - Angle * *Normal\z)
rRay\length = #MaxDist
rRay\PrimitiveHit = -1
rRay\Inside = *Ray\Inside
Intersect_Spheres(rRay)
Shade(rRay, Depth + 1)
mColorSet(*Ray\Col, *Ray\Col\r + rRay\Col\r, *Ray\Col\g + rRay\Col\g, *Ray\Col\b + rRay\Col\b)
EndIf
EndIf
If *Material\Transmittance > 0.0
rRay\Weight = *Ray\Weight * *Material\Transmittance * (1 - Fresnel)
*Ray\Weight * (1-0 - *Material\Transmittance * (1 - Fresnel))
If rRay\Weight > 0.003
; we assume that outside of the refractive object is air or vacuum (index of refraction = 1.0)
OutsideIoR = 1.0
If *Ray\Inside
RelativeIoR = *Material\IndexOfRefraction / OutsideIoR
rRay\Inside = #False
Else
RelativeIoR = OutsideIoR / *Material\IndexOfRefraction
rRay\Inside = #True
EndIf
; we have to make sure the origin of the ray is below the surface
mVectorSet(rRay\Origin, *HitPosition\x - #FpError * *Normal\x, *HitPosition\y - #FpError * *Normal\y, *HitPosition\z - #FpError * *Normal\z)
Angle = *Ray\Direction\x * *Normal\x + *Ray\Direction\y * *Normal\y + *Ray\Direction\z * *Normal\z
SinT2 = RelativeIoR * RelativeIoR * (1.0 - Angle * Angle)
If SinT2 <= 1.0 ; if there is no total internal reflection:
v = RelativeIoR * Angle + Sqr(1.0 - SinT2)
mVectorSet(rRay\Direction, RelativeIoR * *Ray\Direction\x - v * *Normal\x, RelativeIoR * *Ray\Direction\y - v * *Normal\y, RelativeIoR * *Ray\Direction\z - v * *Normal\z)
rRay\length = #MaxDist
rRay\PrimitiveHit = -1
rRay\inside = *Ray\inside
Intersect_Spheres(rRay)
Shade(rRay, Depth + 1)
mColorSet(*Ray\Col, *Ray\Col\r + rRay\Col\r, *Ray\Col\g + rRay\Col\g, *Ray\Col\b + rRay\Col\b)
EndIf
EndIf
EndIf
EndIf
EndProcedure
Procedure Shader_Default(*Ray.Ray, *Material.Material, Depth.i)
Protected HitPosition.Vec3, Normal.Vec3, LightDiffuseColor.Color, LightSpecularColor.Color
mVectorSet(HitPosition, *Ray\Origin\x + *Ray\length * *Ray\Direction\x, *Ray\Origin\y + *Ray\length * *Ray\Direction\y, *Ray\Origin\z + *Ray\length * *Ray\Direction\z)
GetSphereNormal(*Ray\PrimitiveHit, *Ray, HitPosition, Normal)
GetLight(*Ray, HitPosition, Normal, LightDiffuseColor, LightSpecularColor)
ReflectTransmit(*Ray, HitPosition, *Material, Normal, Depth)
*Ray\Col\r + *Ray\Weight * (*Material\DiffuseColor\r * LightDiffuseColor\r + LightSpecularColor\r)
*Ray\Col\g + *Ray\Weight * (*Material\DiffuseColor\g * LightDiffuseColor\g + LightSpecularColor\g)
*Ray\Col\b + *Ray\Weight * (*Material\DiffuseColor\b * LightDiffuseColor\b + LightSpecularColor\b)
EndProcedure
Procedure Shader_Sky(*Ray.Ray, *Material.Material, Depth.i)
Protected Angle.f, Brightness.f, Sun.f
Angle = 0.15 + *Ray\Direction\y * 0.85
If Angle < 0.0
Angle = 0.0
EndIf
Angle = 1.0 - Angle
Angle * Angle
Brightness = 0.1 + 0.4 * Angle * Angle
Angle = *Ray\Direction\x * Light\Direction\x + *Ray\Direction\y * Light\Direction\y + *Ray\Direction\z * Light\Direction\z
*Ray\Col\r + Brightness * *Ray\Weight
*Ray\Col\g + Brightness * *Ray\Weight
*Ray\Col\b + 0.7 * *Ray\Weight
If Angle > 0.99
Sun = Pow(Angle, 1024)
If Sun > 1.0
Sun = 1.0
EndIf
*Ray\Col\r + Sun * Light\Color\r * *Ray\Weight
*Ray\Col\g + Sun * Light\Color\g * *Ray\Weight
*Ray\Col\b + Sun * Light\Color\b * *Ray\Weight
EndIf
EndProcedure
Procedure Shader_Wood(*Ray.Ray, *Material.Material, Depth.i)
Protected HitPosition.Vec3, Normal.Vec3, LightDiffuseColor.Color, LightSpecularColor.Color, Brightness.f, SphIdx.i, RelHit.Vec3, dst.f, rings.f, Col.Color
mVectorSet(HitPosition, *Ray\Origin\x + *Ray\length * *Ray\Direction\x, *Ray\Origin\y + *Ray\length * *Ray\Direction\y, *Ray\Origin\z + *Ray\length * *Ray\Direction\z)
GetSphereNormal(*Ray\PrimitiveHit, *Ray, HitPosition, Normal)
GetLight(*Ray, HitPosition, Normal, LightDiffuseColor, LightSpecularColor)
SphIdx = *Ray\PrimitiveHit
mVectorSet(RelHit, HitPosition\x - SphereX(SphIdx), HitPosition\y - SphereY(SphIdx), HitPosition\z - SphereZ(SphIdx))
RelHit\x * 0.95 + 0.05 * Noise2d(4 * (RelHit\x), 4 * (RelHit\z))
RelHit\z * 0.95 + 0.05 * Noise2d(4 * (RelHit\x), 4 * (RelHit\z))
dst = 0.8 * Sqr(RelHit\x * RelHit\x + RelHit\z * RelHit\z)
dst + Noise2d(0.25 * (7 + RelHit\x), 0.25 * (0.3 + RelHit\z))
Brightness = 0.8 + 0.2 * Pow(Sin(10.0 * dst), 6)
Brightness * (0.85 + 0.15 * Noise2d(100 * (RelHit\x), 100 * (RelHit\z)))
Brightness * (0.85 + 0.15 * Noise2d(dst * 2.0, 20 + 1.2 * dst))
*Ray\Col\r + *Ray\Weight * Brightness * (*Material\DiffuseColor\r * LightDiffuseColor\r + LightSpecularColor\r)
*Ray\Col\g + *Ray\Weight * Brightness * (*Material\DiffuseColor\g * LightDiffuseColor\g + LightSpecularColor\g)
*Ray\Col\b + *Ray\Weight * Brightness * (*Material\DiffuseColor\b * LightDiffuseColor\b + LightSpecularColor\b)
EndProcedure
Procedure Shader_Circles(*Ray.Ray, *Material.Material, Depth.i)
Protected HitPosition.Vec3, Normal.Vec3, LightDiffuseColor.Color, LightSpecularColor.Color, Brightness.f, di.i
mVectorSet(HitPosition, *Ray\Origin\x + *Ray\length * *Ray\Direction\x, *Ray\Origin\y + *Ray\length * *Ray\Direction\y, *Ray\Origin\z + *Ray\length * *Ray\Direction\z)
GetSphereNormal(*Ray\PrimitiveHit, *Ray, HitPosition, Normal)
GetLight(*Ray, HitPosition, Normal, LightDiffuseColor, LightSpecularColor)
Brightness = 0.3 + 0.03 * Noise2d(7 * HitPosition\x, 7 * HitPosition\z)
di = 0.01 * Sqr(HitPosition\x * HitPosition\x + HitPosition\z * HitPosition\z)
If di & 1
Brightness * 3.0
mColorSet(LightSpecularColor, 0.1 * LightSpecularColor\r, 0.1 * LightSpecularColor\g, 0.1 * LightSpecularColor\b)
EndIf
*Ray\Col\r + *Ray\Weight * Brightness * (*Material\DiffuseColor\r * LightDiffuseColor\r + LightSpecularColor\r)
*Ray\Col\g + *Ray\Weight * Brightness * (*Material\DiffuseColor\g * LightDiffuseColor\g + LightSpecularColor\g)
*Ray\Col\b + *Ray\Weight * Brightness * (*Material\DiffuseColor\b * LightDiffuseColor\b + LightSpecularColor\b)
EndProcedure
Procedure Shader_Eye(*Ray.Ray, *Material.Material, Depth.i)
Protected HitPosition.Vec3, Normal.Vec3, LightDiffuseColor.Color, LightSpecularColor.Color, Brightness.f, Col.Color, ReflectedLightVector.Vec3, Intensity.f, SV.i
Protected SphIdx.i, ViewDir.Vec3, rView.Vec3, rHit.Vec3, LVAngle.f, HitDir.Vec3, rLength.f, Angle.f, PupilS.f, u.f, v.f, SpecF.f, a3.f
mVectorSet(HitPosition, *Ray\Origin\x + *Ray\length * *Ray\Direction\x, *Ray\Origin\y + *Ray\length * *Ray\Direction\y, *Ray\Origin\z + *Ray\length * *Ray\Direction\z)
GetSphereNormal(*Ray\PrimitiveHit, *Ray, HitPosition, Normal)
GetLight(*Ray, HitPosition, Normal, LightDiffuseColor, LightSpecularColor)
SphIdx = *Ray\PrimitiveHit
mVectorSet(ViewDir, EyeCam(SphIdx)\Dir\x, EyeCam(SphIdx)\Dir\y, EyeCam(SphIdx)\Dir\z)
mNormalize(ViewDir, rLength)
mVectorSet(HitDir, HitPosition\x - SphereX(SphIdx), HitPosition\y - SphereY(SphIdx), HitPosition\z - SphereZ(SphIdx))
mNormalize(HitDir, rLength)
LVAngle = ViewDir\x * Light\Direction\x + ViewDir\y * Light\Direction\y + ViewDir\z * Light\Direction\z
If LVAngle < 0.0 : LVAngle = 0.0 : EndIf
PupilS = 0.993 - 0.012 * (1.0 - LVAngle)
Angle = ViewDir\x * HitDir\x + ViewDir\y * HitDir\y + ViewDir\z * HitDir\z
mVectorSet(rView, -ViewDir\z, 0, ViewDir\x)
mNormalize(rView, rLength)
mCross(rHit, HitDir, ViewDir)
mNormalize(rHit, rLength)
Brightness = 0.8
mColorSet(Col, 0.9, 0.9, 0.9)
v = ACos(rView\x * rHit\x + rView\z * rHit\z) : If v = 0.0 : v = 0.0001 : EndIf
If Angle > 0.87
If Angle > PupilS
Brightness = 0.01
If Angle < PupilS + 0.002
Brightness = 0.8 - 360 * (Angle - PupilS)
EndIf
EndIf
If Angle < 0.88
Brightness = 0.8 - 80.0 * (Angle - 0.87)
ElseIf Angle < 0.94
Brightness = 0.2 + 10.0 * (Angle - 0.88)
EndIf
If Angle > 0.88
If Angle <= PupilS + 0.002
SV = SphIdx * 7
a3 = Angle * Angle * Angle
Angle * (0.96 + 0.04 * Noise2d(SV + 50 * (0.5 - v), SV + 50 * a3))
v * (0.97 + 0.03 * Noise2d(SV + 20 * a3, SV + 20 * (0.5 - v)))
Col\r = *Material\DiffuseColor\r * (0.5 + 0.17 * Noise2d(SV + 70 * (0.5 - 0.5 * Angle), SV + 50 * (0.5 + 0.5 * v)))
Col\g = *Material\DiffuseColor\g * (0.5 + 0.17 * Noise2d(SV + 100 + 50 * (0.5 - 0.5 * Angle), SV + 50 * (0.5 + 0.5 * v)))
Col\b = *Material\DiffuseColor\b * (0.5 + 0.17 * Noise2d(SV + 200 + 50 * (0.5 - 0.5 * Angle), SV + 50 * (0.5 + 0.5 * v)))
EndIf
SpecF = 0.5 * (LightSpecularColor\r + LightSpecularColor\g + LightSpecularColor\b)
If Specf > 0.0
mVectorSet(Normal, HitPosition\x - (SphereX(SphIdx) + 0.6 * ViewDir\x), HitPosition\y - (SphereY(SphIdx) + 0.6 * ViewDir\y), HitPosition\z - (SphereZ(SphIdx) + 0.6 * ViewDir\z))
mNormalize(Normal, rLength)
Angle = 2.0 * (Normal\x * Light\Direction\x + Normal\y * Light\Direction\y + Normal\z * Light\Direction\z)
mVectorSet(ReflectedLightVector, Light\Direction\x - Angle * Normal\x, Light\Direction\y - Angle * Normal\y, Light\Direction\z - Angle * Normal\z)
Angle = *Ray\Direction\x * ReflectedLightVector\x + *Ray\Direction\y * ReflectedLightVector\y + *Ray\Direction\z * ReflectedLightVector\z
If Angle > 0.0
Intensity = SpecF * Pow(Angle, 60)
mColorSet(LightSpecularColor, Intensity, Intensity, Intensity)
EndIf
EndIf
EndIf
EndIf
Brightness * (0.85 + 0.02 * Noise2d(30 * (Angle), 30 * (v)))
*Ray\Col\r + *Ray\Weight * (Brightness * Col\r * LightDiffuseColor\r + LightSpecularColor\r)
*Ray\Col\g + *Ray\Weight * (Brightness * Col\g * LightDiffuseColor\g + LightSpecularColor\g)
*Ray\Col\b + *Ray\Weight * (Brightness * Col\b * LightDiffuseColor\b + LightSpecularColor\b)
EndProcedure
Procedure Shader_Monitor(*Ray.Ray, *Material.Material, Depth.i)
Protected SphIdx.i, HitPosition.Vec3, HitDir.Vec3, ProjDir.Vec3, rLength.f, CamRay.Ray, Normal.Vec3, LightDiffuseColor.Color, LightSpecularColor.Color, Brightness.f, Col.Color, dst.f, Blend.f, Cam.i
SphIdx = *Ray\PrimitiveHit
mVectorSet(HitPosition, *Ray\Origin\x + *Ray\length * *Ray\Direction\x, *Ray\Origin\y + *Ray\length * *Ray\Direction\y, *Ray\Origin\z + *Ray\length * *Ray\Direction\z)
mVectorSet(HitDir, HitPosition\x - SphereX(SphIdx), HitPosition\y - SphereY(SphIdx), HitPosition\z - SphereZ(SphIdx))
mNormalize(HitDir, rLength)
Blend = 0.0 : Cam = -1
If Display\RenderQuality > 1 And (Abs(HitDir\x) > 0.9 Or Abs(HitDir\z) > 0.9)
dst = HitDir\x * HitDir\x + HitDir\y * HitDir\y
If dst < 0.15
Blend = 1.0
If dst > 0.14
Blend = 100.0 * (0.15 - dst)
EndIf
If HitDir\z < 0.0
mVectorSet(ProjDir, HitDir\x, HitDir\y, -0.9 * HitDir\z)
Cam = 3
Else
mVectorSet(ProjDir, HitDir\x, HitDir\y, 0.9 * HitDir\z)
Cam = 2
EndIf
Else
dst = HitDir\z * HitDir\z + HitDir\y * HitDir\y
If dst < 0.15
Blend = 1.0
If dst > 0.14
Blend = 100.0 * (0.15 - dst)
EndIf
EndIf
If HitDir\x < 0.0
mVectorSet(ProjDir, HitDir\z, HitDir\y, -0.9 * HitDir\x)
Cam = 1
Else
mVectorSet(ProjDir, HitDir\z, HitDir\y, 0.9 * HitDir\x)
Cam = 0
EndIf
EndIf
If Cam >= 0
mNormalize(ProjDir, rLength)
MatrixVec3Rotation(CamRay\Direction, ProjDir, EyeCam(Cam)\Mat)
mVectorSet(CamRay\Origin, EyeCam(Cam)\Pos\x + 1.1 * CamRay\Direction\x * SphereRadius(Cam), EyeCam(Cam)\Pos\y + 1.1 * CamRay\Direction\y * SphereRadius(Cam), EyeCam(Cam)\Pos\z + 1.1 * CamRay\Direction\z * SphereRadius(Cam))
CamRay\PrimitiveHit = -1
CamRay\length = #MaxDist
mColorSet(CamRay\Col, 0, 0, 0)
CamRay\Weight = *Ray\Weight
CamRay\inside = 0
Intersect_Spheres(CamRay)
Shade(CamRay, Depth + 1)
mColorSet(*Ray\Col, *Ray\Col\r + Blend * CamRay\Col\r, *Ray\Col\g + Blend * CamRay\Col\g, *Ray\Col\b + Blend * CamRay\Col\b)
EndIf
EndIf
If Blend < 1.0
Blend = 1.0 - Blend
GetSphereNormal(*Ray\PrimitiveHit, *Ray, HitPosition, Normal)
GetLight(*Ray, HitPosition, Normal, LightDiffuseColor, LightSpecularColor)
ReflectTransmit(*Ray, HitPosition, *Material, Normal, Depth)
Brightness = 0.965 + 0.035 * (Noise2d(10 * (HitPosition\x), 10 * (HitPosition\z)))
*Ray\Col\r + Blend * *Ray\Weight * Brightness * (*Material\DiffuseColor\r * LightDiffuseColor\r + LightSpecularColor\r)
*Ray\Col\g + Blend * *Ray\Weight * Brightness * (*Material\DiffuseColor\g * LightDiffuseColor\g + LightSpecularColor\g)
*Ray\Col\b + Blend * *Ray\Weight * Brightness * (*Material\DiffuseColor\b * LightDiffuseColor\b + LightSpecularColor\b)
EndIf
EndProcedure
Procedure Shade(*Ray.Ray, Depth.i)
Protected *Material.Material
If *Ray\PrimitiveHit >= 0 And Depth < 50
*Material = *SphereMaterial(*Ray\PrimitiveHit)
CallFunctionFast(*Material\Shader, *Ray, *Material, Depth)
Else
Shader_Sky(*Ray, Main\Material_Background, Depth)
EndIf
EndProcedure
Procedure PrimaryRaysCreate(*Job.Job, pPrimRays.i)
Protected *Ray.Ray, TP.Vec3, i.i, rLength.f
*Ray = pPrimRays
mVectorSet(TP, Camera\VScrTL\x + *Job\x * Camera\PixOffsX\x + *Job\y * Camera\PixOffsY\x, Camera\VScrTL\y + *Job\x * Camera\PixOffsX\y + *Job\y * Camera\PixOffsY\y, Camera\VScrTL\z + *Job\x * Camera\PixOffsX\z + *Job\y * Camera\PixOffsY\z)
For i = *Job\Offset To #TileSize * #TileSize - 1 Step 16
mVectorSet(*Ray\Origin, Camera\Pos\x, Camera\Pos\y, Camera\Pos\z)
mVectorSet(*Ray\Direction, TP\x + RayPattern(i)\px * Camera\PixOffsX\x + RayPattern(i)\py * Camera\PixOffsY\x, TP\y + RayPattern(i)\px * Camera\PixOffsX\y + RayPattern(i)\py * Camera\PixOffsY\y, TP\z + RayPattern(i)\px * Camera\PixOffsX\z + RayPattern(i)\py * Camera\PixOffsY\z)
mNormalize(*Ray\Direction, rLength)
*Ray\PrimitiveHit = -1
*Ray\length = #MaxDist
mColorSet(*Ray\Col, 0, 0, 0)
*Ray\Weight = 1.0
*Ray\inside = 0
*Ray + SizeOf(Ray)
Next
EndProcedure
Procedure.f RenderTile(*Job.Job, pPrimRays.i)
Protected BufferStart.i, *Buffer.Long, *B.Long, *Material.Material, i.i, *Ray.Ray, Col.Color, idx.i, r0.i, g0.i, b0.i, r1.i, g1.i, b1.i, dr.i, dg.i, db.i, d.f, error.f, maxError.f, f.f, rLength.f
PrimaryRaysCreate(*Job, pPrimRays)
*Ray = pPrimRays
BufferStart = Display\pBuffer + (*Job\x + 1) * 4 + (*Job\y + 1) * Display\BufferPitch
If Display\RenderQuality > 0
For i = *Job\Offset To #TileSize * #TileSize - 1 Step 16
Intersect_Spheres(*Ray)
Shade(*Ray, 1)
*Buffer = BufferStart + RayPattern(i)\Buffer
b0 = Red(*Buffer\l) : g0 = Green(*Buffer\l) : r0 = Blue(*Buffer\l)
idx = 8192 * *Ray\Col\r : If idx > 8191 : idx = 8191 : EndIf : r1 = GammaLUT(idx & 8191)
idx = 8192 * *Ray\Col\g : If idx > 8191 : idx = 8191 : EndIf : g1 = GammaLUT(idx & 8191)
idx = 8192 * *Ray\Col\b : If idx > 8191 : idx = 8191 : EndIf : b1 = GammaLUT(idx & 8191)
dr = r1 - r0 : dg = g1 - g0 : db = b1 - b0
d = Abs(dr) + Abs(dg) + Abs(db)
error + d * d
*Buffer\l = RGB(b1, g1, r1)
If Main\Moved > 2
*B = *Buffer - 4 : *B\l = RGB(b1, g1, r1)
*B = *Buffer + 4 : *B\l = RGB(b1, g1, r1)
*B = *Buffer - Display\BufferPitch : *B\l = RGB(b1, g1, r1)
*B = *Buffer + Display\BufferPitch : *B\l = RGB(b1, g1, r1)
*B = *Buffer - Display\BufferPitch - 4 : *B\l = RGB(b1, g1, r1)
*B = *Buffer - Display\BufferPitch + 4 : *B\l = RGB(b1, g1, r1)
*B = *Buffer + Display\BufferPitch - 4 : *B\l = RGB(b1, g1, r1)
*B = *Buffer + Display\BufferPitch + 4 : *B\l = RGB(b1, g1, r1)
EndIf
*Ray + SizeOf(Ray)
Next
*Job\Error = error / (585225 * #TileSize * #TileSize / 16)
ProcedureReturn *Job\Error
Else
For i = *Job\Offset To #TileSize * #TileSize - 1 Step 16
Intersect_Spheres(*Ray)
*Buffer = BufferStart + RayPattern(i)\Buffer
mColorSet(Col, 500.0 / *Ray\length, 50.0 / *Ray\length, 10.0 / *Ray\length)
If Col\b > 1.0 : Col\b = 1.0 : EndIf
If Col\g > 1.0 : Col\g = 1.0 : EndIf
If Col\r > 1.0 : Col\r = 1.0 : EndIf
*Buffer\l = RGB(Col\b * 255, Col\g * 255, Col\r * 255)
*Ray + SizeOf(Ray)
Next
EndIf
EndProcedure
Procedure Move()
Protected i.i, Dir.Vec3, rLength.f, Angle, CamMat.Matrix, VDir.Vec3
If Main\Moved = 4
MatrixIdentity(CamMat)
MatrixRotateX(CamMat, Main\RotX)
MatrixRotateY(CamMat, Main\RotY)
mVectorSet(VDir, 0.0, 0.0, 1.0)
MatrixVec3Rotation(VDir, VDir, CamMat)
mVectorSet(Dir, Main\MovSide, Main\MovUpDown, Main\MovFwd)
MatrixVec3Rotation(Dir, Dir, Camera\Matrix)
mVectorSet(Camera\Pos, Camera\Pos\x + Dir\x, Camera\Pos\y + Dir\y, Camera\Pos\z + Dir\z)
Camera\Matrix = CamMat
Main\ViewDir = VDir
EndIf
If Main\Moved > 0 : Main\Moved - 1 : EndIf
mVectorSet(EyeCam(Main\Eye)\Dir, Main\ViewDir\x, Main\ViewDir\y, Main\ViewDir\z)
mVectorSet(EyeCam(Main\Eye)\Pos, Camera\Pos\x - 1.1 * Main\ViewDir\x * SphereRadius(Main\Eye), Camera\Pos\y - 1.1 * Main\ViewDir\y * SphereRadius(Main\Eye), Camera\Pos\z - 1.1 * Main\ViewDir\z * SphereRadius(Main\Eye))
EyeCam(Main\Eye)\RotX = Main\RotX
EyeCam(Main\Eye)\RotY = Main\RotY
mVectorSet(Dir, Camera\Pos\x - EyeCam(2)\Pos\x, Camera\Pos\y - EyeCam(2)\Pos\y, Camera\Pos\z - EyeCam(2)\Pos\z)
EyeCam(2)\RotX = Dir\y / Sqr(Dir\x * Dir\x + Dir\y * Dir\y + Dir\z * Dir\z)
EyeCam(2)\RotY = ATan2(Dir\z, -Dir\x)
EyeCam(3)\RotX = -0.3
EyeCam(3)\RotY - 0.0003 * Main\AvTime
For i = 0 To 3
EyeCamNxt(i)\RotX = EyeCam(i)\RotX : EyeCamNxt(i)\RotY = EyeCam(i)\RotY
MatrixIdentity(EyeCamNxt(i)\Mat)
MatrixRotateX(EyeCamNxt(i)\Mat, EyeCam(i)\RotX)
MatrixRotateY(EyeCamNxt(i)\Mat, EyeCam(i)\RotY)
mVectorSet(EyeCamNxt(i)\Dir, 0.0, 0.0, 1.0)
MatrixVec3Rotation(EyeCamNxt(i)\Dir, EyeCamNxt(i)\Dir, EyeCamNxt(i)\Mat)
If i = 3
mVectorSet(EyeCamNxt(3)\Pos, EyeCamNxt(i)\Dir\x * -200, 70, EyeCamNxt(i)\Dir\z * -200)
Else
mVectorSet(EyeCamNxt(i)\Pos, EyeCam(i)\Pos\x, EyeCam(i)\Pos\y, EyeCam(i)\Pos\z)
EndIf
EyeCam(i) = EyeCamNxt(i) ; pixels are constantly rendered, so I need to switch to the new values quickly, to reduce the chance of pixel errors...
SphereX(i) = EyeCam(i)\Pos\x : SphereY(i) = EyeCam(i)\Pos\y : SphereZ(i) = EyeCam(i)\Pos\z ; ...otherwise I would need to halt rendering for scene updates
Next i
EndProcedure
Procedure ThreadsDoWork(ThreadIdx)
Protected iJob, pPrimRays.i, error.f, loop.i
pPrimRays = AllocateMemory(#TileSize * #TileSize * SizeOf(Ray))
While Main\Running
If loop > 2 Or (Main\Moved And error < 0.0001) Or (Main\Moved = 0 And error < 0.00001)
iJob = -1
LockMutex(mutJob)
If numJobs > JobIdx
iJob = JobIdx
JobIdx + 1
loop = 0
If JobIdx >= numJobs
JobIdx = 0
Density + 1
EndIf
EndIf
UnlockMutex(mutJob)
If Job(iJob)\error < 0.000001
Job(iJob)\error = 0.1
iJob = -1
EndIf
EndIf
loop + 1
If iJob > -1
error = RenderTile(@Job(iJob)\x, pPrimRays)
Job(iJob)\Offset = (Job(iJob)\Offset + 1) & 15
EndIf
Delay(0)
Wend
EndProcedure
Procedure ThreadsCreate()
Protected i
Main\NumThreads = CountCPUs(#PB_System_ProcessCPUs)
For i = 0 To Main\NumThreads - 1
CreateThread(@ThreadsDoWork(), i)
Next
EndProcedure
Procedure ThreadsSetUpJobs()
Protected x, y, i
ReDim Job((Display\RenderWidth * Display\RenderHeight) / (#TileSize * #TileSize))
For y = 0 To Display\RenderHeight - 1 Step #TileSize
For x = 0 To Display\RenderWidth - 1 Step #TileSize
Job(i)\x = x
Job(i)\y = y
i + 1
Next x
Next y
numJobs = i
JobIdx = 0
EndProcedure
Procedure SceneCreate()
Protected i.i, rLength.f, MatIdx.i, *mat.Material
*mat = RTMaterialCreate(0.16, 0.28, 0.36, @Shader_Eye())
*mat\SpecularIntensity = 0.3
SphereCreate(0, 20, 0, 10, *mat)
*mat = RTMaterialCreate(0.08, 0.16, 0.24, @Shader_Eye())
*mat\SpecularIntensity = 0.3
SphereCreate(-70, 20, 0, 10, *mat)
*mat = RTMaterialCreate(0.16, 0.32, 0.28, @Shader_Eye())
*mat\SpecularIntensity = 0.3
SphereCreate(-10, 20, 0, 10, *mat)
*mat = RTMaterialCreate(0.32, 0.28, 0.04, @Shader_Eye())
*mat\SpecularIntensity = 0.3
SphereCreate(-100, 20, 0, 10, *mat)
*mat = RTMaterialCreate(0.04, 0.01, 0.001, @Shader_Wood())
*mat\SpecularIntensity = 0.14
*mat\Glossiness = 16
SphereCreate(-10, 10, 10, 10, *mat)
*mat = RTMaterialCreate(0.02, 0.04, 0.08, @Shader_Monitor())
*mat\Reflectance = 0.001
*mat\Glossiness = 40
SphereCreate(30, 24.7, 50, 25, *mat)
*mat = RTMaterialCreate(0.0, 0.01, 0.08)
*mat\Reflectance = 0.70
*mat\SpecularIntensity = 0.0
SphereCreate(-60, 24.2, 70, 25, *mat)
*mat = RTMaterialCreate(0.2, 0.16, 0.1, @Shader_Circles())
*mat\SpecularIntensity = 0.5
SphereCreate(0, -5000, 0, 5000, *mat)
FirstElement(Sphere())
For i = 0 To ListSize(Sphere()) - 1 ; we need to turn the primitive data
SphereX(i) = Sphere()\Position\x ; into a SIMD (SSE) friendly format.
SphereY(i) = Sphere()\Position\y ; Lists and multithreading don't play nice, anyway
SphereZ(i) = Sphere()\Position\z
SphereRadius(i) = Sphere()\radius
*SphereMaterial(i) = Sphere()\Material
NextElement(Sphere())
Next i
mVectorSet(Light\Direction, 1, 1, -1)
mNormalize(Light\Direction, rLength)
mColorSet(Light\Color, 1.3, 1.2, 0.95)
Light\k = 25 ; for soft shadows. Smaller k = softer shadow
mColorSet(Sky, 0.12, 0.12, 0.15)
mVectorSet(Camera\Pos, -20, 30, -150)
mVectorSet(EyeCam(1)\Pos, -20, 30, 150)
EyeCam(1)\RotY = #PI
EyeCam(1)\RotX = -0.1
mVectorSet(EyeCam(2)\Pos, -60, 30, 0)
EndProcedure
Procedure InitPerlinNoise()
Protected n.i
For n = 0 To 255
PNPermut(n) = n
PNGradient(n) = n / 127.5 - 1.0
Next
For n = 0 To 255
Swap PNPermut(n), PNPermut(Random(255))
Swap PNGradient(n), PNGradient(Random(255))
Next
PNPermut(256) = PNPermut(0)
PNGradient(256) = PNGradient(0)
EndProcedure
Procedure InitGammaLut()
Protected i.i, v.f
For i = 0 To 8191
v = i / 8192
GammaLUT(i) = 255 * Pow(v, 1.0 / 2.2)
Next i
EndProcedure
Procedure Init(Width.i, Height.i)
Protected i.i
For i = 0 To 255
Read.i PixelPattern(i)
Next i
Display\RenderQuality = 2
Display\Resolution = 1
Display\SoftShadow = 1
Main\MouseLook = 1
Main\Moved = 1
glWindowOpen(Width, Height)
InitMouse()
Main\Shader_Default = @Shader_Default()
Main\Material_Default = RTMaterialCreate(1.0, 1.0, 1.0)
Main\Material_Background = RTMaterialCreate(0.0, 0.0, 0.0, @Shader_Sky())
Main\MouseX = DesktopMouseX() : Main\MouseY = DesktopMouseY()
MatrixIdentity(Camera\Matrix)
InitPerlinNoise()
InitGammaLut()
Move()
SceneCreate()
RTCameraUpdate()
AddElement(Info()) : Info() = "'escape' to exit"
AddElement(Info()) : Info() = "+/- to change window size"
AddElement(Info()) : Info() = "WSAD or numpad to move"
AddElement(Info()) : Info() = "ctrl>down / space>up / shift>faster"
AddElement(Info()) : Info() = "left click or 'return' to toggle mouse look"
AddElement(Info()) : Info() = "R to cycle resolution"
AddElement(Info()) : Info() = "Q to cycle render quality"
AddElement(Info()) : Info() = "C to switch camera"
ThreadsSetUpJobs()
Main\Running = #True
ThreadsCreate()
JobIdx = 0
EndProcedure
Procedure CheckEvents(AvTime.f)
Protected Event.i, key, size.i, ToggleML.i, Dir.Vec3
Main\movFwd = 0 : Main\MovSide = 0 : Main\MovUpDown = 0
Main\speed = 1
Repeat
Event = WindowEvent()
Select Event
Case #PB_Event_CloseWindow
Main\Running = #False
EndSelect
If EventType() = #PB_EventType_LeftButtonDown
ToggleML = 1
EndIf
key = GetGadgetAttribute(0, #PB_OpenGL_Key)
If EventType() = #PB_EventType_KeyDown
If key < 256 : KeyDown(key) = 1 : EndIf
If key = 17 : KeyControl = 1 : EndIf
EndIf
If EventType() = #PB_EventType_KeyUp
If key < 256 : KeyDown(key) = 0 : EndIf
If key = 17 : KeyControl = 0 : EndIf
Select key
Case #PB_Shortcut_Escape
Main\Running = #False
Case #PB_Shortcut_Add
size = #TileSize
Case #PB_Shortcut_Subtract
size = -#TileSize
Case #PB_Shortcut_L
Display\SoftShadow = 1 - Display\SoftShadow
Case #PB_Shortcut_Q
Display\RenderQuality - 1
If Display\RenderQuality < 0 : Display\RenderQuality = 2 : EndIf
Case #PB_Shortcut_R
Display\Resolution + 1
If Display\Resolution > 2 : Display\Resolution = 0 : EndIf
glWindowOpen(Display\VisibleWidth, Display\VisibleHeight)
ThreadsSetUpJobs()
Case #PB_Shortcut_Left
Main\InfoTime = ElapsedMilliseconds()
If Not PreviousElement(Info())
LastElement(Info())
EndIf
Case #PB_Shortcut_Right
Main\InfoTime = ElapsedMilliseconds()
If Not NextElement(Info())
FirstElement(Info())
EndIf
Case #PB_Shortcut_C
Main\Eye = 1 - Main\Eye : Main\Moved = 4
Main\RotX = EyeCam(Main\Eye)\RotX
Main\RotY = EyeCam(Main\Eye)\RotY
MatrixRotateX(Camera\Matrix, Main\RotX)
MatrixRotateY(Camera\Matrix, Main\RotY)
mVectorSet(Main\ViewDir, 0.0, 0.0, -1.0)
MatrixVec3Rotation(Main\ViewDir, Main\ViewDir, Camera\Matrix)
mVectorSet(Camera\Pos, EyeCam(Main\Eye)\Pos\x + 1.1 * Main\ViewDir\x * SphereRadius(Main\Eye), EyeCam(Main\Eye)\Pos\y + 1.1 * Main\ViewDir\y * SphereRadius(Main\Eye), EyeCam(Main\Eye)\Pos\z + 1.1 * Main\ViewDir\z * SphereRadius(Main\Eye))
mVectorSet(Camera\Pos, Camera\Pos\x, Camera\Pos\y, Camera\Pos\z)
EndSelect
EndIf
If KeyDown(#PB_Shortcut_W) Or KeyDown(#PB_Shortcut_Pad8)
Main\MovFwd = 0.03 * AvTime * Main\speed : Main\Moved = 4
EndIf
If KeyDown(#PB_Shortcut_S) Or KeyDown(#PB_Shortcut_Pad5)
Main\MovFwd = -0.03 * AvTime * Main\speed : Main\Moved = 4
EndIf
If KeyDown(#PB_Shortcut_A) Or KeyDown(#PB_Shortcut_Pad4)
Main\MovSide = -0.03 * AvTime * Main\speed : Main\Moved = 4
EndIf
If KeyDown(#PB_Shortcut_D) Or KeyDown(#PB_Shortcut_Pad6)
Main\MovSide = 0.03 * AvTime * Main\speed : Main\Moved = 4
EndIf
If KeyDown(#PB_Shortcut_Space) Or KeyDown(110)
Main\MovUpDown = 0.03 * AvTime * Main\speed : Main\Moved = 4
EndIf
If KeyControl Or KeyDown(#PB_Shortcut_Pad0)
Main\MovUpDown = -0.03 * AvTime * Main\speed : Main\Moved = 4
EndIf
If KeyDown(16) Or KeyDown(#PB_Shortcut_Pad1)
Main\speed = 4
EndIf
If KeyDown(#PB_Shortcut_Return)
ToggleML = 1
EndIf
Until Event = 0
If Main\MouseLook And GetActiveWindow() = -1
ToggleML = 1
EndIf
If ToggleML
Main\MouseLook = 1 - Main\MouseLook
If Main\MouseLook
SetGadgetAttribute(0, #PB_OpenGL_Cursor, #PB_Cursor_Invisible)
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
SetCursorPos_(WindowX(0) + WindowWidth(0) / 2, WindowY(0) + WindowHeight(0) / 2)
CompilerEndIf
Main\MouseX = DesktopMouseX() : Main\MouseY = DesktopMouseY()
Else
SetGadgetAttribute(0, #PB_OpenGL_Cursor, #PB_Cursor_Default)
EndIf
EndIf
If Main\MouseLook
If DesktopMouseX() - Main\MouseX <> 0 Or DesktopMouseY() - Main\MouseY <> 0
Main\Moved = 4
EndIf
Main\RotY - 0.002 * (DesktopMouseX() - Main\MouseX)
Main\RotX - 0.002 * (DesktopMouseY() - Main\MouseY)
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
SetCursorPos_(WindowX(0) + WindowWidth(0) / 2, WindowY(0) + WindowHeight(0) / 2)
CompilerEndIf
Main\MouseX = DesktopMouseX() : Main\MouseY = DesktopMouseY()
If Main\RotX > 0.49 * #PI
Main\RotX = 0.49 * #PI
EndIf
If Main\RotX < -0.49 * #PI
Main\RotX = -0.49 * #PI
EndIf
EndIf
If size <> 0
If WindowX(0) - 3 * size > 0 And WindowY(0) - 2 * size > 0
If Display\VisibleWidth + 6 * size >= #TileSize * 2 And Display\VisibleHeight + 4 * size >= #TileSize * 2
glWindowOpen(Display\VisibleWidth + 6 * size, Display\VisibleHeight + 4 * size)
ThreadsSetUpJobs()
EndIf
EndIf
EndIf
EndProcedure
Procedure Main()
Protected time.i, NewAvTime.f, Event.i, InfoTime.i, NoFlip.i, AvDensity.f
Init(768, 448)
Main\InfoTime = ElapsedMilliseconds()
While Main\Running
If ElapsedMilliseconds() > Main\FlipTarget
DisplayBufferShow(Display\pBuffer)
Main\FlipTarget = ElapsedMilliseconds() + 16
Time = ElapsedMilliseconds() - Main\FlipTime
Main\FlipTime = ElapsedMilliseconds()
If ElapsedMilliseconds() - Main\InfoTime > 4000
Main\InfoTime = ElapsedMilliseconds()
If Not NextElement(Info())
FirstElement(Info())
EndIf
EndIf
NewAvTime = time
If Abs(NewAvTime - Main\AvTime) > NewAvTime * 0.4
Main\AvTime = NewAvTime
Else
Main\AvTime = Main\AvTime * 0.95 + NewAvTime * 0.05
EndIf
AvDensity = AvDensity * 0.95 + Density * 0.05
Density = 0
Main\Time = ElapsedMilliseconds() - Main\Time
SetWindowTitle(Display\WindowNr, "FPS: " + Right(" " + Str(1000 / Main\AvTime), 4) + " / Pixel Density: " + Left(StrF(AvDensity / 16.0), 5) + " / <crsr> " + info())
CheckEvents(Main\AvTime)
Move()
RTCameraUpdate()
EndIf
Delay(0)
Wend
Delay(200) ; Wait for threads to finish
EndProcedure
Main()
Pattern:
DataSection
Data.i 11, 14, 0, 5, 13, 1, 9, 4, 2, 8, 12, 6, 7, 10, 15, 3
Data.i 1, 9, 7, 12, 14, 8, 4, 3, 15, 5, 2, 10, 0, 11, 6, 13
Data.i 8, 6, 13, 0, 2, 9, 5, 12, 14, 4, 3, 11, 1, 15, 10, 7
Data.i 2, 4, 9, 13, 15, 3, 6, 8, 11, 1, 7, 14, 10, 12, 5, 0
Data.i 15, 10, 5, 2, 8, 14, 7, 0, 6, 9, 13, 1, 12, 3, 11, 4
Data.i 12, 2, 8, 7, 1, 4, 15, 9, 13, 10, 0, 5, 3, 6, 14, 11
Data.i 14, 1, 6, 9, 10, 5, 3, 13, 0, 7, 11, 12, 15, 4, 2, 8
Data.i 13, 11, 4, 3, 12, 0, 10, 6, 8, 15, 1, 7, 2, 14, 9, 5
Data.i 3, 7, 14, 10, 5, 15, 0, 11, 1, 12, 4, 8, 6, 2, 13, 9
Data.i 0, 5, 10, 15, 7, 2, 8, 14, 3, 13, 9, 4, 11, 1, 12, 6
Data.i 6, 8, 3, 14, 0, 10, 13, 7, 4, 11, 15, 2, 9, 5, 1, 12
Data.i 7, 0, 15, 11, 6, 12, 2, 10, 5, 14, 8, 3, 13, 9, 4, 1
Data.i 10, 15, 1, 4, 3, 13, 11, 5, 12, 0, 6, 9, 14, 7, 8, 2
Data.i 4, 13, 11, 1, 9, 6, 12, 2, 7, 3, 10, 15, 5, 8, 0, 14
Data.i 5, 12, 2, 8, 11, 7, 1, 15, 9, 6, 14, 0, 4, 13, 3, 10
Data.i 9, 3, 12, 6, 4, 11, 14, 1, 10, 2, 5, 13, 8, 0, 7, 15

