Code : Tout sélectionner
;Traduction de ce code
;https://www.scratchapixel.com/code.php?id=3&origin=/lessons/3d-basic-rendering/introduction-To-ray-tracing
#INFINITY = 1e8
#MAX_RAY_DEPTH = 5
Structure vector3
x.f
y.f
z.f
EndStructure
Structure sphere
center.vector3
radius.f
radius2.f
surfaceColor.vector3
reflection.f
transparency.f
emissionColor.vector3
EndStructure
Macro AddSphere(n,cx,cy,cz,r,sx,sy,sz,f,t,ex,ey,ez)
spheres(n)\center\x = cx
spheres(n)\center\y = cy
spheres(n)\center\z = cz
spheres(n)\radius = r
spheres(n)\radius2 = spheres(n)\radius*spheres(n)\radius
spheres(n)\surfaceColor\x = sx
spheres(n)\surfaceColor\y = sy
spheres(n)\surfaceColor\z = sz
spheres(n)\reflection = f
spheres(n)\transparency = t
spheres(n)\emissionColor\x = ex
spheres(n)\emissionColor\y = ey
spheres(n)\emissionColor\z = ez
EndMacro
Procedure.f length2(*v.vector3)
ProcedureReturn *v\x * *v\x + *v\y * *v\y + *v\z * *v\z
EndProcedure
Procedure length(*v.vector3)
ProcedureReturn Sqr(length2(*v))
EndProcedure
Procedure normalize(*v.vector3)
nor2.f = length2(*v)
If (nor2 > 0)
invNor.f = 1.0 / Sqr(nor2)
*v\x * invNor
*v\y * invNor
*v\z * invNor
EndIf
EndProcedure
Procedure.f min(a.f, b.f)
If b<a
ProcedureReturn b
Else
ProcedureReturn a
EndIf
EndProcedure
Procedure.f max(a.f, b.f)
If b>a
ProcedureReturn b
Else
ProcedureReturn a
EndIf
EndProcedure
Procedure.f dot(*v1.vector3, *v2.vector3)
ProcedureReturn *v1\x**v2\x + *v1\y**v2\y + *v1\z**v2\z
EndProcedure
;Compute a ray-sphere intersection using the geometric solution
Procedure intersect(*s.sphere, *rayorig.vector3, *raydir.vector3, *t0.Float, *t1.Float)
l.vector3
l\x = *s\center\x - *rayorig\x
l\y = *s\center\y - *rayorig\y
l\z = *s\center\z - *rayorig\z
tca.f = dot(@l, *raydir)
If tca < 0
ProcedureReturn #False
Debug "la"
EndIf
d2.f = dot(@l, @l) - tca * tca
If d2 > *s\radius2
ProcedureReturn #False
EndIf
thc.f = Sqr(*s\radius2 - d2)
*t0\f = tca - thc
*t1\f = tca + thc
ProcedureReturn #True
EndProcedure
;This variable controls the maximum recursion depth
Procedure.f mix(a.f, b.f, mix.f)
ProcedureReturn b * mix + a * (1 - mix)
EndProcedure
;This is the main trace function. It takes a ray As argument (defined by its origin And direction).
;We test If this ray intersects any of the geometry in the scene. If the ray intersects an object,
;we compute the intersection point, the normal at the intersection point, And shade this point using this information.
;Shading depends on the surface property (is it transparent, reflective, diffuse).
;The function returns a color For the ray. If the ray intersects an object that is the color of the object at the intersection point,
;otherwise it returns the background color.
Procedure trace(*Result.vector3, *rayorig.vector3, *raydir.vector3, Array spheres.sphere(1), depth)
;If (raydir.length() != 1) std::cerr << "Error " << raydir << std::endl;
tnear.f = #INFINITY
Protected *sphere.sphere
; find intersection of this ray With the sphere in the scene
For i = 0 To ArraySize(spheres())
t0.f = #INFINITY
t1.f = #INFINITY
If intersect(@spheres(i), *rayorig, *raydir, @t0, @t1)
If (t0 < 0)
t0 = t1
EndIf
If t0 < tnear
tnear = t0
*sphere = @spheres(i)
EndIf
EndIf
Next
; If there's no intersection return black or background color
If *sphere=0
*Result\x = 2
*Result\y = 2
*Result\z = 2
ProcedureReturn
EndIf
surfaceColor.vector3; // color of the ray/surfaceof the object intersected by the ray
phit.vector3 ; // point of intersection
phit\x = *rayorig\x + *raydir\x * tnear
phit\y = *rayorig\y + *raydir\y * tnear
phit\z = *rayorig\z + *raydir\z * tnear
nhit.vector3 ; // normal at the intersection point
nhit\x = phit\x - *sphere\center\x
nhit\y = phit\y - *sphere\center\y
nhit\z = phit\z - *sphere\center\z
normalize(@nhit); // normalize normal direction
; If the normal And the view direction are Not opposite To each other
; reverse the normal direction. That also means we are inside the sphere so set
; the inside bool To true. Finally reverse the sign of IdotN which we want
; positive.
bias.f = 1e-4 ; // add some bias to the point from which we will be tracing
inside = #False
If dot(*raydir, @nhit) > 0
nhit\x = -nhit\x
nhit\y = -nhit\y
nhit\z = -nhit\z
inside = #True
EndIf
If (*sphere\transparency > 0 Or *sphere\reflection > 0) And depth < #MAX_RAY_DEPTH
facingratio.f = -dot(*raydir,@nhit)
; change the mix value To tweak the effect
fresneleffect.f = mix(Pow(1 - facingratio, 3), 1, 0.1)
; compute reflection direction (Not need To normalize because all vectors
; are already normalized)
refldir.vector3
refldir\x = *raydir\x - nhit\x * 2 * dot(*raydir, @nhit)
refldir\y = *raydir\y - nhit\y * 2 * dot(*raydir, @nhit)
refldir\z = *raydir\z - nhit\z * 2 * dot(*raydir, @nhit)
normalize(@refldir)
reflection.vector3
prov.vector3
prov\x = phit\x + nhit\x * bias
prov\y = phit\y + nhit\y * bias
prov\z = phit\z + nhit\z * bias
trace(@reflection, @prov, @refldir, spheres(), depth + 1)
refraction.vector3
; If the sphere is also transparent compute refraction ray (transmission)
If *sphere\transparency
ior.f = 1.1
If inside; are we inside or outside the surface?
eta = ior
Else
eta = 1.0 / ior
EndIf
cosi.f = -dot(@nhit,*raydir)
k.f = 1 - eta * eta * (1 - cosi * cosi)
refrdir.vector3
refrdir\x = *raydir\x * eta + nhit\x * (eta * cosi - Sqr(k))
refrdir\y = *raydir\y * eta + nhit\y * (eta * cosi - Sqr(k))
refrdir\z = *raydir\z * eta + nhit\z * (eta * cosi - Sqr(k))
normalize(@refrdir)
prov\x = phit\x - nhit\x * bias
prov\y = phit\y - nhit\y * bias
prov\z = phit\z - nhit\z * bias
trace(@refraction, prov, refrdir, spheres(), depth + 1)
EndIf
; the result is a mix of reflection And refraction (If the sphere is transparent)
surfaceColor\x = ( reflection\x * fresneleffect + refraction\x * (1 - fresneleffect) * *sphere\transparency) * *sphere\surfaceColor\x
surfaceColor\y = ( reflection\y * fresneleffect + refraction\y * (1 - fresneleffect) * *sphere\transparency) * *sphere\surfaceColor\y
surfaceColor\z = ( reflection\z * fresneleffect + refraction\z * (1 - fresneleffect) * *sphere\transparency) * *sphere\surfaceColor\z
Else
; it's a diffuse object, no need to raytrace any further
For i = 0 To ArraySize(spheres())
If (spheres(i)\emissionColor\x > 0)
; this is a light
transmission.vector3
transmission\x = 1
transmission\y = 1
transmission\z = 1
lightDirection.vector3
lightDirection\x = spheres(i)\center\x - phit\x
lightDirection\y = spheres(i)\center\y - phit\y
lightDirection\z = spheres(i)\center\z - phit\z
normalize(lightDirection)
For j = 0 To ArraySize(spheres())
If i <> j
t0.f
t1.f
prov\x = phit\x + nhit\x * bias
prov\y = phit\y + nhit\y * bias
prov\z = phit\z + nhit\z * bias
If intersect(@spheres(j), @prov, @lightDirection, @t0, @t1)
transmission\x = 0
transmission\y = 0
transmission\z = 0
Break
EndIf
EndIf
Next
surfaceColor\x + *sphere\surfaceColor\x * transmission\x * max(0, dot(@nhit, @lightDirection)) * spheres(i)\emissionColor\x
surfaceColor\y + *sphere\surfaceColor\y * transmission\y * max(0, dot(@nhit, @lightDirection)) * spheres(i)\emissionColor\y
surfaceColor\z + *sphere\surfaceColor\z * transmission\z * max(0, dot(@nhit, @lightDirection)) * spheres(i)\emissionColor\z
EndIf
Next
EndIf
*Result\x = surfaceColor\x + *sphere\emissionColor\x
*Result\y = surfaceColor\y + *sphere\emissionColor\y
*Result\z = surfaceColor\z + *sphere\emissionColor\z
EndProcedure
;Main rendering function. We compute a camera ray For each pixel of the image trace it And Return a color.
;If the ray hits a sphere, we Return the color of the sphere at the intersection point, Else we Return the background color.
Procedure render(Array spheres.sphere(1))
width = 640
height = 480
Dim image.vector3(width * height)
*pixel.vector3 = image()
invWidth.f = 1.0 / width
invHeight.f = 1.0 / height
fov.f = 30.0
aspectratio.f = width / height
angle.f = Tan(#PI * 0.5 * fov / 180.0);
; Trace rays
For y = 0 To height-1
For x = 0 To width-1
*pixel+SizeOf(vector3)
xx.f = (2 * ((x + 0.5) * invWidth) - 1) * angle * aspectratio
yy.f = (1 - 2 * ((y + 0.5) * invHeight)) * angle
raydir.vector3
raydir\x = xx
raydir\y = yy
raydir\z = -1
normalize(@raydir)
prov.vector3
prov\x = 0
prov\y = 0
prov\z = 0
trace(*pixel,@prov, @raydir, spheres(), 0)
Next
Next
StartDrawing(SpriteOutput(0))
k=0
For j = 0 To height-1
For i=0 To width-1
Plot(i,j, RGB(min(1, image(k)\x) * 255, min(1, image(k)\y) * 255,min(1, image(k)\z) * 255))
k+1
Next
Next
StopDrawing()
EndProcedure
;In the main function, we will create the scene which is composed of 5 spheres And 1 light (which is also a sphere).
;Then, once the scene description is complete we render that scene, by calling the render() function.
Procedure main()
Dim spheres.sphere(5)
; position, radius, surface color, reflectivity, transparency, emission color
AddSphere(0, 0.0, -10004, -20, 10000, 0.20, 0.20, 0.20, 0, 0.0, 0, 0, 0)
AddSphere(1, 0.0, 0, -20, 4, 1.00, 0.32, 0.36, 1, 0.5, 0, 0, 0)
AddSphere(2, 5.0, -1, -15, 2, 0.90, 0.76, 0.46, 1, 0.0, 0, 0, 0)
AddSphere(3, 5.0, 0, -25, 3, 0.65, 0.77, 0.97, 1, 0.0, 0, 0, 0)
AddSphere(4, -5.5, 0, -15, 3, 0.90, 0.90, 0.90, 1, 0.0, 0, 0, 0)
; light
AddSphere(5, 0.0, 20, -30, 3, 0.0, 0.00, 0.00, 0, 0.0, 3, 3, 3)
render(spheres())
EndProcedure
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
MessageRequester("Error", "Can't open the sprite system", 0)
End
EndIf
If OpenWindow(0, 0, 0, 640, 480, "Gadget and sprites!", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
If OpenWindowedScreen(WindowID(0), 0, 0, 640, 480, 0, 0, 0)
CreateSprite(0,640, 480)
main()
ReleaseMouse(1)
Repeat
Repeat
; Always process all the events to flush the queue at every frame
Event = WindowEvent()
Select Event
Case #PB_Event_CloseWindow
Quit = 1
EndSelect
Until Event = 0 ; Quit the event loop only when no more events are available
ExamineKeyboard()
ExamineMouse()
; Clear the screen and draw our sprites
ClearScreen(RGB(0,0,0))
DisplaySprite(0,0, 0)
FlipBuffers() ; Inverse the buffers (the back become the front (visible)... and we can do the rendering on the back
Until Quit Or KeyboardPushed(#PB_Key_Escape)
Else
MessageRequester("Error", "Can't open windowed screen!", 0)
EndIf
EndIf