Original post from Thygrion, taken from the ezboard forum
Hey guys!
Last night, I started on a new project - Raytracing.
Originally, it only supported spheres, but then today I added planes into the mix.
Now what I have here are some raytraced spheres bouncing off a plane.
;
; Raytraced Bouncy Balls
;
AppTitle "Raytraced Bouncy Balls"
Const width = 320
Const height = 240
Graphics width,height,32,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()
Type plane
Field nx#
Field ny#
Field nz#
Field dis#
Field argb
End Type
Type sphere
Field x#
Field y#
Field z#
Field xv#
Field yv#
Field zv#
Field argb
End Type
Dim p.plane(1)
Dim s.sphere(1)
Dim normalx#(width,height)
Dim normaly#(width,height)
Dim normalz#(width,height)
Global planes = 1
Global spheres = 3
Global sphererad# = 100.0
Global sphererad2# = Float(sphererad# * sphererad#)
Global camerax#
Global cameray#
Global cameraz# = -800.0
Global lightx#
Global lighty# = 800.0
Global lightz#
Global spec# = 10.0
Global grav# = .3
Global fric# = .25
setupplanes()
setupspheres()
s(0)\argb = $FF0000
s(1)\argb = $00FF00
s(2)\argb = $0000FF
setupnormals()
While Not KeyDown(1)
Cls
LockBuffer
raytrace()
UnlockBuffer
For i = 0 To spheres - 1
s(i)\x# = s(i)\x# + s(i)\xv#
s(i)\y# = s(i)\y# + s(i)\yv#
s(i)\z# = s(i)\z# + s(i)\zv#
s(i)\yv# = s(i)\yv# - grav#
If s(i)\y# - sphererad# < -p(0)\dis#
s(i)\y# = -p(0)\dis# + sphererad#
s(i)\xv# = Float(s(i)\xv# * fric#)
s(i)\yv# = Float(-s(i)\yv# * fric#)
s(i)\zv# = Float(s(i)\zv# * fric#)
If s(i)\xv# > -fric# Or s(i)\xv# < fric# Then s(i)\xv# = 0
If s(i)\zv# > -fric# Or s(i)\zv# < fric# Then s(i)\zv# = 0
EndIf
Next
If KeyDown(203) Then camerax# = camerax# - 50.0
If KeyDown(205) Then camerax# = camerax# + 50.0
If KeyDown(200) Then cameraz# = cameraz# + 50.0
If KeyDown(208) Then cameraz# = cameraz# - 50.0
Flip
Wend
For i = 0 To planes - 1
Delete p(i)
Next
For i = 0 To spheres - 1
Delete s(i)
Next
End
Function setupplanes()
Dim p.plane(planes)
For i = 0 To planes - 1
p.plane(i) = New plane
p(i)\ny# = 1.0
p(i)\dis# = Float(sphererad# * 4.0)
p(i)\argb = $686868;Rand($686868,$FFFFFF)
Next
End Function
Function setupspheres()
Dim s.sphere(spheres)
Local sr# = Float(sphererad# * 2.5)
;Local an# = Rnd(360.0)
;Local ani# = Float(360.0 / spheres)
For i = 0 To spheres - 1
s.sphere(i) = New sphere
s(i)\x# = Rnd(-sr#,sr#)
s(i)\y# = Rnd(0,sphererad#)
s(i)\z# = Rnd(-sr#,sr#)
s(i)\xv# = Rnd(-5.0,5.0)
s(i)\yv# = Rnd(-2.0,7.0)
s(i)\zv# = Rnd(-5.0,5.0)
s(i)\argb = Rand($686868,$FFFFFF)
; an# = an# + ani#
Next
End Function
Function setupnormals()
Local nx#
Local ny#
Local nz# = 200.0
Local dis#
For y = 0 To height - 1
ny# = Float(height Shr 1) - Float(y)
For x = 0 To width - 1
nx# = Float(width Shr 1) - Float(x)
dis# = Sqr(Float(nx# * nx#) + Float(ny# * ny#) + Float(nz# * nz#))
normalx#(x,y) = -Float(nx# / dis#)
normaly#(x,y) = Float(ny# / dis#)
normalz#(x,y) = Float(nz# / dis#)
Next
Next
End Function
Function raytrace()
Local argb
For y = 0 To height - 1
For x = 0 To width - 1
argb = ray(camerax#,cameray#,cameraz#,normalx#(x,y),normaly#(x,y),normalz#(x,y),256)
If argb <> $000000 Then WritePixelFast x,y,argb
Next
Next
End Function
Function ray(ex#,ey#,ez#,evx#,evy#,evz#,c)
If c <= 32 Then Return
Local plane.plane
Local sphere.sphere
Local z# = 10000
Local svx#
Local svy#
Local svz#
Local ix#
Local iy#
Local iz#
Local nx#
Local ny#
Local nz#
Local rnx#
Local rny#
Local rnz#
Local lvx#
Local lvy#
Local lvz#
Local dxis#
Local ydis#
Local zdis#
Local dxis2#
Local ydis2#
Local zdis2#
Local dis#
Local dis2#
Local l#
Local c1
Local c2
Local c3
Local r
Local g
Local b
For i = 0 To planes - 1
plane.plane = p(i)
nx# = plane\nx#
ny# = plane\ny#
nz# = plane\nz#
dis# = Float(Float(nx# * evx#) + Float(ny# * evy#) + Float(nz# * evz#))
If dis# < 0
dis2# = Float(-Float(plane\dis# + Float(Float(nx# * ex#) + Float(ny# * ey#) + Float(nz# * ez#))) / dis#)
ix# = ex# + Float(evx# * dis2#)
iy# = ey# + Float(evy# * dis2#)
iz# = ez# + Float(evz# * dis2#)
lvx# = Float(lightx# - ix#)
lvy# = Float(lighty# - iy#)
lvz# = Float(lightz# - iz#)
dis# = Sqr(Float(lvx# * lvx#) + Float(lvy# * lvy#) + Float(lvz# * lvz#))
lvx# = Float(lvx# / dis#)
lvy# = Float(lvy# / dis#)
lvz# = Float(lvz# / dis#)
l# = Float(Float(nx# * lvx#) + Float(ny# * lvy#) + Float(nz# * lvz#))
dis# = Float(Float(Float(nx# * evx#) + Float(ny# * evy#) + Float(nz# * evz#)) * 2.0)
rnx# = evx# - Float(nx# * dis#)
rny# = evy# - Float(ny# * dis#)
rnz# = evz# - Float(nz# * dis#)
c1 = Int(l# * 256.0)
c2 = Int(Float(Float(rnx# * lvx#) + Float(rny# * lvy#) + Float(rnz# * lvz#))^spec# * 256.0)
argb = plane\argb
z# = dis2#
EndIf
Next
For i = 0 To spheres - 1
sphere.sphere = s(i)
svx# = sphere\x# - ex#
svy# = sphere\y# - ey#
svz# = sphere\z# - ez#
dis2# = Float(Float(svx# * evx#) + Float(svy# * evy#) + Float(svz# * evz#))
dis# = Float(Float(svx# * svx#) + Float(svy# * svy#) + Float(svz# * svz#)) - Float(dis2# * dis2#)
If dis# <= sphererad2#
dis2# = dis2# - Sqr(sphererad2# - dis#)
If dis2# > 0 And dis2# < z#
ix# = ex# + Float(evx# * dis2#)
iy# = ey# + Float(evy# * dis2#)
iz# = ez# + Float(evz# * dis2#)
nx# = Float(Float(ix# - sphere\x#) / sphererad#)
ny# = Float(Float(iy# - sphere\y#) / sphererad#)
nz# = Float(Float(iz# - sphere\z#) / sphererad#)
lvx# = Float(lightx# - ix#)
lvy# = Float(lighty# - iy#)
lvz# = Float(lightz# - iz#)
dis# = Sqr(Float(lvx# * lvx#) + Float(lvy# * lvy#) + Float(lvz# * lvz#))
lvx# = Float(lvx# / dis#)
lvy# = Float(lvy# / dis#)
lvz# = Float(lvz# / dis#)
l# = Float(Float(nx# * lvx#) + Float(ny# * lvy#) + Float(nz# * lvz#))
dis# = Float(Float(Float(nx# * evx#) + Float(ny# * evy#) + Float(nz# * evz#)) * 2.0)
rnx# = evx# - Float(nx# * dis#)
rny# = evy# - Float(ny# * dis#)
rnz# = evz# - Float(nz# * dis#)
c1 = Int(l# * 256.0)
c2 = Int(Float(Float(rnx# * lvx#) + Float(rny# * lvy#) + Float(rnz# * lvz#))^spec# * 256.0)
argb = sphere\argb
z# = dis2#
EndIf
EndIf
Next
If shadowed(ix#,iy#,iz#)
c1 = 30
c2 = 0
Else
If c1 < 30 Then c1 = 30
If c2 < 0 Then c2 = 0
EndIf
c3 = (c1 * c) Shr 8
r = ((argb And $FF0000) * c3) Shr 8
g = ((argb And $00FF00) * c3) Shr 8
b = ((argb And $0000FF) * c3) Shr 8
r = r + (c2 Shl 16)
g = g + (c2 Shl 8)
b = b + c2
If argb <> $000000 Then argb = ray(ix#,iy#,iz#,rnx#,rny#,rnz#,c - 32)
r = r + (argb And $FF0000)
g = g + (argb And $00FF00)
b = b + (argb And $0000FF)
If r > $FF0000
r = $FF0000
Else
r = r And $FF0000
EndIf
If g > $00FF00
g = $00FF00
Else
g = g And $00FF00
EndIf
If b > $0000FF
b = $0000FF
Else
b = b And $0000FF
EndIf
Return r Or g Or b
End Function
Function shadowed(x#,y#,z#)
Local plane.plane
Local sphere.sphere
Local shad = False
Local evx# = Float(lightx# - x#)
Local evy# = Float(lighty# - y#)
Local evz# = Float(lightz# - z#)
Local dis# = Sqr(Float(evx# * evx#) + Float(evy# * evy#) + Float(evz# * evz#))
Local dis2#
evx# = Float(evx# / dis#)
evy# = Float(evy# / dis#)
evz# = Float(evz# / dis#)
For i = 0 To planes - 1
plane.plane = p(i)
nx# = plane\nx#
ny# = plane\ny#
nz# = plane\nz#
dis# = Float(Float(nx# * evx#) + Float(ny# * evy#) + Float(nz# * evz#))
If dis# < 0
shad = True
i = planes - 1
EndIf
Next
If shad = False
For i = 0 To spheres - 1
sphere.sphere = s(i)
svx# = sphere\x# - x#
svy# = sphere\y# - y#
svz# = sphere\z# - z#
dis2# = Float(Float(svx# * evx#) + Float(svy# * evy#) + Float(svz# * evz#))
dis# = Float(Float(svx# * svx#) + Float(svy# * svy#) + Float(svz# * svz#)) - Float(dis2# * dis2#)
If dis2# > 0 And dis# < sphererad2#
shad = True
i = spheres - 1
EndIf
Next
EndIf
Return shad
End Function
I just thought I'd share this with you, since it's not really fast enough for a demo.
Now I'll probably implement ray-poly collisions.
Enjoy!
Thygrion
Man that's really sweet! Thanks for posting it Jake.
This is where Blitz struggles really, I'd bet it would be a lot faster in C++ or purebasic.
Or maybe Frebasic.
Next time I talk to Fryer maybe he could translate it for me.
- Thygrion
Wow, that's a great effect
About speeding it up, you may want to talk to StoneMonkey on CW
he's done quite a lot of raytracing and he's got it quite fast now
Really cool effect!
Looking forward to see the fast version.
Thanks, guys!
@Turkwoyz, Stonemonkey = Fryer 
- Thygrion
I was drawn to this topic because it's what I have been trying to make for ages.
I have lost interest in programming three times because of ray tracing, I'd get quite far with it and then just give up, I just ran this program and it works really, really well.
Well done and it's great that you have put the source in here for everyone to see for themselves how it is done.
Your code is very good Thygrion, amongst the best I've seen.
Well done.
Let's hope you don't lose heart this time and stick around a bit longer?
Great piece of code !!! i have translate it under bmax
just for fun
But i have a question ? it is possible to change light color ? Camera pointing ?
Filax, is this much faster using Bmax?
I'd be really interested to know.. Unfortunately I don't have Bmax but I'm looking to find my next programming language, looking at C++ and Purebasic at the moment but maybe if Bmax has the speed it would be worth considering?
Yes it's more speed ! i think that bmax is more speed than purebasic
I have try the two version , blitz3D and bmax, bmax is winner.
Do you see my question about light color ?
My guess is that you could change the light intensities by changing these masks;
If r > $FF0000
r = $FF0000
Else
r = r And $FF0000
EndIf
If g > $00FF00
g = $00FF00
Else
g = g And $00FF00
EndIf
If b > $0000FF
b = $0000FF
Else
b = b And $0000FF
EndIf
Return r Or g Or b
End Function
Not my code though so there may be a more elegant way of doing it
Hi
I have made this change, because bmax use some different
mask for argb color, this mask include an alpha parameter
ALPHA => RED => GREEN => BLUE
For this reason i have made this
If r > $00FF0000
r = $00FF0000
Else
r = r & $00FF0000
EndIf
If g > $0000FF00
g = $0000FF00
Else
g = g & $0000FF00
EndIf
If b > $000000FF
b = $000000FF
Else
b = b & $000000FF
EndIf
Return $FF000000 | r | g | b
End Function
I'm searching for the light color but the code is a little bit confusing
for me
I'm searching too a solution to change or add the camera pointing ?
any idea ?
I'll have to have a play with it and see if I can work out what does what for you... Unless Jake comes back in the meantime. I'll look at this today.
Ok, I've worked out the light
Now I'll work out the camera, will post an in depth answer for you later on this evening
Fantastic !!! i'm playing like a child with your great piece of code
I have added a little stuf to make balle rebounce with key space !
And i have clean a little bit my previous code
Blitzmax code :
---------------------
Type TBBType
Field _list:TList
Field _link:TLink
Method Remove()
_list.remove Self
End Method
End Type
Global sphere_list:TList=New TList
Global plane_list:TList=New TList
Const width = 320
Const height = 240
Graphics width,height,32,75
SeedRnd MilliSecs()
Global RenderImage:Timage=CreateImage(width,height,DYNAMICIMAGE)
Type bbplane Extends TBBType
Field nx#
Field ny#
Field nz#
Field dis#
Field argb
End Type
Type bbsphere Extends TBBType
Field x#
Field y#
Field z#
Field xv#
Field yv#
Field zv#
Field argb
End Type
Global planes = 1
Global spheres = 3
Global p:bbplane[planes+1]
Global s:bbsphere[spheres+1]
Global normalx#[width+1,height+1]
Global normaly#[width+1,height+1]
Global normalz#[width+1,height+1]
Global sphererad# = 100.0
Global sphererad2# = Float(sphererad# * sphererad#)
Global camerax# =0
Global cameray# =0
Global cameraz# = -800.0
Global lightx# = 0
Global lighty# = 800.0
Global lightz# = 0
Global spec# = 100.0
Global grav# = .3
Global fric# = .25
setupplanes()
setupspheres()
setupnormals()
While Not KeyHit(KEY_ESCAPE)
Cls
raytrace()
'SetScale 1.1,1.1
DrawImage RenderIMage,0,0
'SetScale 1,1
' -----------------------
' Apply gravity to sphere
' -----------------------
For i = 0 To spheres - 1
s(i).x# = s(i).x# + s(i).xv#
s(i).y# = s(i).y# + s(i).yv#
s(i).z# = s(i).z# + s(i).zv#
s(i).yv# = s(i).yv# - grav#
If s(i).y# - sphererad# + sphererad#
s(i).xv# = Float(s(i).xv# * fric#)
s(i).yv# = Float(-s(i).yv# * fric#)
s(i).zv# = Float(s(i).zv# * fric#)
If s(i).xv# > -fric# Or s(i).xv# -fric# Or s(i).zv# - 50.0
If KeyDown(KEY_RIGHT) Then camerax# = camerax# + 50.0
If KeyDown(KEY_UP) Then cameraz# = cameraz# + 50.0
If KeyDown(KEY_DOWN) Then cameraz# = cameraz# - 50.0
' --------------------
' Made jump the sphere
' --------------------
If KeyHit(KEY_SPACE)
For i = 0 To spheres - 1
s(i).yv# = Rnd(16,20)
Next
EndIf
Flip
Wend
' --------
' Quit app
' --------
For i = 0 To planes - 1
p(i).Remove()
Next
For i = 0 To spheres - 1
s(i).Remove()
Next
End
' ---------------------
' Setup plane primitive
' ---------------------
Function setupplanes()
For i = 0 To planes - 1
p:bbplane(i) = New bbplane
p(i).ny# = 1.0
' p(i).dis# = Float(sphererad# * 4.0)
p(i).dis# = 200
p(i).argb = Rand($686868,$FFFFFF)
Next
End Function
' ----------------------
' Setup sphere primitive
' ----------------------
Function setupspheres()
Local sr# = Float(sphererad# * 2.5)
'Local an# = Rnd(360.0)
'Local ani# = Float(360.0 / spheres)
For i = 0 To spheres - 1
s:bbsphere(i) = New bbsphere
s(i).x# = Rnd(-sr#,sr#)
s(i).y# = Rnd(0,sphererad#)
s(i).z# = Rnd(-sr#,sr#)
s(i).xv# = Rnd(-10.0,10.0)
s(i).yv# = Rnd(-2.0,7.0)
s(i).zv# = Rnd(-10.0,10.0)
s(i).argb = Rand($111111,$FFFFFF)
'an# = an# + ani#
Next
End Function
Function setupnormals()
Local nx#
Local ny#
Local nz# = 200.0
Local dis#
For y = 0 To height - 1
ny# = Float(height Shr 1) - Float(y)
For x = 0 To width - 1
nx# = Float(width Shr 1) - Float(x)
dis# = Sqr(Float(nx# * nx#) + Float(ny# * ny#) + Float(nz# * nz#))
normalx#(x,y) = -Float(nx# / dis#)
normaly#(x,y) = Float(ny# / dis#)
normalz#(x,y) = Float(nz# / dis#)
Next
Next
End Function
' ------------------
' Raytrace the image
' ------------------
Function raytrace()
Local argb
RenderMap=LockImage(RenderImage)
For y = 0 To height - 1
For x = 0 To width - 1
argb = ray(camerax#,cameray#,cameraz#,normalx#(x,y),normaly#(x,y),normalz#(x,y),256)
If argb $00000000 Then WritePixel RenderMap,x,y,argb
Next
Next
UnlockImage (RenderImage)
RenderMap=Null
End Function
' ----------------------
' Raytracing computation
' ----------------------
Function ray(ex#,ey#,ez#,evx#,evy#,evz#,c)
If c = 32 Then Return
Local plane:bbplane
Local sphere:bbsphere
Local z# = 10000
Local svx#
Local svy#
Local svz#
Local ix#
Local iy#
Local iz#
Local nx#
Local ny#
Local nz#
Local rnx#
Local rny#
Local rnz#
Local lvx#
Local lvy#
Local lvz#
Local dxis#
Local ydis#
Local zdis#
Local dxis2#
Local ydis2#
Local zdis2#
Local dis#
Local dis2#
Local l#
Local c1
Local c2
Local c3
Local a
Local r
Local g
Local b
For i = 0 To planes - 1
plane:bbplane = p(i)
nx# = plane.nx#
ny# = plane.ny#
nz# = plane.nz#
dis# = Float(Float(nx# * evx#) + Float(ny# * evy#) + Float(nz# * evz#))
If dis# + Float(Float(nx# * ex#) + Float(ny# * ey#) + Float(nz# * ez#))) / dis#)
ix# = ex# + Float(evx# * dis2#)
iy# = ey# + Float(evy# * dis2#)
iz# = ez# + Float(evz# * dis2#)
lvx# = Float(lightx# - ix#)
lvy# = Float(lighty# - iy#)
lvz# = Float(lightz# - iz#)
dis# = Sqr(Float(lvx# * lvx#) + Float(lvy# * lvy#) + Float(lvz# * lvz#))
lvx# = Float(lvx# / dis#)
lvy# = Float(lvy# / dis#)
lvz# = Float(lvz# / dis#)
l# = Float(Float(nx# * lvx#) + Float(ny# * lvy#) + Float(nz# * lvz#))
dis# = Float(Float(Float(nx# * evx#) + Float(ny# * evy#) + Float(nz# * evz#)) * 2.0)
rnx# = evx# - Float(nx# * dis#)
rny# = evy# - Float(ny# * dis#)
rnz# = evz# - Float(nz# * dis#)
c1 = Int(l# * 256.0)
c2 = Int(Float(Float(rnx# * lvx#) + Float(rny# * lvy#) + Float(rnz# * lvz#))^spec# * 256.0)
argb = plane.argb
z# = dis2#
EndIf
Next
For i = 0 To spheres - 1
sphere:bbsphere = s(i)
svx# = sphere.x# - ex#
svy# = sphere.y# - ey#
svz# = sphere.z# - ez#
dis2# = Float(Float(svx# * evx#) + Float(svy# * evy#) + Float(svz# * evz#))
dis# = Float(Float(svx# * svx#) + Float(svy# * svy#) + Float(svz# * svz#)) - Float(dis2# * dis2#)
If dis# = sphererad2#
dis2# = dis2# - Sqr(sphererad2# - dis#)
If dis2# > 0 And dis2# + Float(evx# * dis2#)
iy# = ey# + Float(evy# * dis2#)
iz# = ez# + Float(evz# * dis2#)
nx# = Float(Float(ix# - sphere.x#) / sphererad#)
ny# = Float(Float(iy# - sphere.y#) / sphererad#)
nz# = Float(Float(iz# - sphere.z#) / sphererad#)
lvx# = Float(lightx# - ix#)
lvy# = Float(lighty# - iy#)
lvz# = Float(lightz# - iz#)
dis# = Sqr(Float(lvx# * lvx#) + Float(lvy# * lvy#) + Float(lvz# * lvz#))
lvx# = Float(lvx# / dis#)
lvy# = Float(lvy# / dis#)
lvz# = Float(lvz# / dis#)
l# = Float(Float(nx# * lvx#) + Float(ny# * lvy#) + Float(nz# * lvz#))
dis# = Float(Float(Float(nx# * evx#) + Float(ny# * evy#) + Float(nz# * evz#)) * 2.0)
rnx# = evx# - Float(nx# * dis#)
rny# = evy# - Float(ny# * dis#)
rnz# = evz# - Float(nz# * dis#)
c1 = Int(l# * 256.0)
c2 = Int(Float(Float(rnx# * lvx#) + Float(rny# * lvy#) + Float(rnz# * lvz#))^spec# * 256.0)
argb = sphere.argb
z# = dis2#
EndIf
EndIf
Next
If shadowed(ix#,iy#,iz#)
c1 = 30
c2 = 0
Else
If c1 * c) Shr 8
r = ((argb & $00FF0000) * c3) Shr 8
g = ((argb & $0000FF00) * c3) Shr 8
b = ((argb & $000000FF) * c3) Shr 8
r = r + (c2 Shl 16)
g = g + (c2 Shl 8)
b = b + c2
If argb $00000000 Then argb = ray(ix#,iy#,iz#,rnx#,rny#,rnz#,c - 32)
r = r + (argb & $00FF0000)
g = g + (argb & $0000FF00)
b = b + (argb & $000000FF)
If r > $00FF0000
r = $00FF0000
Else
r = r & $00FF0000
EndIf
If g > $0000FF00
g = $0000FF00
Else
g = g & $0000FF00
EndIf
If b > $000000FF
b = $000000FF
Else
b = b & $000000FF
EndIf
Return $FF000000 | r | g | b
End Function
' --------------
' Compute shadow
' --------------
Function shadowed(x#,y#,z#)
Local plane:bbplane
Local sphere:bbsphere
Local shad = False
Local evx# = Float(lightx# - x#)
Local evy# = Float(lighty# - y#)
Local evz# = Float(lightz# - z#)
Local dis# = Sqr(Float(evx# * evx#) + Float(evy# * evy#) + Float(evz# * evz#))
Local dis2#
evx# = Float(evx# / dis#)
evy# = Float(evy# / dis#)
evz# = Float(evz# / dis#)
For i = 0 To planes - 1
plane:bbplane = p(i)
nx# = plane.nx#
ny# = plane.ny#
nz# = plane.nz#
dis# = Float(Float(nx# * evx#) + Float(ny# * evy#) + Float(nz# * evz#))
If dis# - 1
EndIf
Next
If shad = False
For i = 0 To spheres - 1
sphere:bbsphere = s(i)
svx# = sphere.x# - x#
svy# = sphere.y# - y#
svz# = sphere.z# - z#
dis2# = Float(Float(svx# * evx#) + Float(svy# * evy#) + Float(svz# * evz#))
dis# = Float(Float(svx# * svx#) + Float(svy# * svy#) + Float(svz# * svz#)) - Float(dis2# * dis2#)
If dis2# > 0 And dis# - 1
EndIf
Next
EndIf
Return shad
End Function
You can download an example executable with height balls + code
for check the FPS value
www.blitz3dfr.com/tempo/Raytrace.zip
I'm very interrested to increase this piece of code
I get an error on decompressing the zip says it's missing some bytes 
I have re-upload the file
I get 3fps (low) to 10 fps(high) and it locked up after a while
But it looked great
Athlon XP2000 + @ 1.7 Ghz
ATI Radeon 9600, 256M
Another guy made a raytracer with pure basic
forums.purebasic.com/engl...sc&start=0
www.flipcode.com/articles...e02-07.png
No gfx card on this PC I'm on right now, will look at it asap!
Got it working here, as it's just onboard graphics I'm getting a really poor 1fps, I'll try it on the computer at home as soon as I can.
Great job though Filax, it looks to be in a higher resolution with more balls.
I hope that Thygrion coming soon to talk about this great piece of code
You could try and PM him, I think he's been pretty busy with school lately.
I tried the code on my fast PC and got 4fps
On my pc i get 12 FPS in 320/240
That's not bad fps at all.
The best thing what I can do for this code (today ) is *Precalculate* everything, so, hope it's usefull for someone...
Run at 60 fps here.
; Raytraced Bouncy Balls
AppTitle "Raytraced Bouncy Balls"
;------------------------ "Frame Per Second" -------------------------
Global iFPS, bSettime,iSecStart,iFrameCount,iFrameStart
;---------------------------------------------------------------------
Const width = 320
Const height = 240
Graphics width,height,32,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()
Type plane
Field nx#
Field ny#
Field nz#
Field dis#
Field argb
End Type
Type sphere
Field x#
Field y#
Field z#
Field xv#
Field yv#
Field zv#
Field argb
End Type
Dim p.plane(1)
Dim s.sphere(1)
Dim normalx#(width,height)
Dim normaly#(width,height)
Dim normalz#(width,height)
Global planes = 1
Global spheres = 3
Global sphererad# = 100.0
Global sphererad2# = Float(sphererad# * sphererad#)
Global camerax#
Global cameray#
Global cameraz# = -1200.0
Global lightx#
Global lighty# = 800.0
Global lightz#
Global spec# = 10.0
Global grav# = .3
Global fric# = .25
setupplanes()
setupspheres()
s(0)\argb = $FF0000
s(1)\argb = $00FF00
s(2)\argb = $0000FF
setupnormals()
;------------------------------------- Screen Buffer -----------------------------------------------
Dim buffer(101,320,240)
PreCalculate()
;---------------------------------------------------------------------------------------------------
While Not KeyHit(1)
Cls
LockBuffer BackBuffer()
For y = 0 To height - 1
For x = 0 To width - 1
pixel = buffer(frame,x,y)
WritePixelFast x,y,pixel,BackBuffer()
Next
Next
UnlockBuffer BackBuffer()
If cnt = 0 Then
frame = frame + 1
If frame > 99 Then cnt = 1
Else
frame = frame - 1
If frame < 1 Then cnt = 0
EndIf
FPS_Count(10,10,255,255,255)
Flip; False
Wend
;---------------------------------------------------------------------------------------------------
For i = 0 To planes - 1
Delete p(i)
Next
For i = 0 To spheres - 1
Delete s(i)
Next
End
Function setupplanes()
Dim p.plane(planes)
For i = 0 To planes - 1
p.plane(i) = New plane
p(i)\ny# = 1.0
p(i)\dis# = Float(sphererad# * 4.0)
p(i)\argb = $686868;Rand($686868,$FFFFFF)
Next
End Function
Function setupspheres()
Dim s.sphere(spheres)
Local sr# = Float(sphererad# * 2.5)
;Local an# = Rnd(360.0)
;Local ani# = Float(360.0 / spheres)
For i = 0 To spheres - 1
s.sphere(i) = New sphere
s(i)\x# = Rnd(-sr#,sr#)
s(i)\y# = Rnd(0,sphererad#)
s(i)\z# = Rnd(-sr#,sr#)
s(i)\xv# = Rnd(-5.0,5.0)
s(i)\yv# = Rnd(-2.0,7.0)
s(i)\zv# = Rnd(-5.0,5.0)
s(i)\argb = Rand($686868,$FFFFFF)
; an# = an# + ani#
Next
End Function
Function setupnormals()
Local nx#
Local ny#
Local nz# = 200.0
Local dis#
For y = 0 To height - 1
ny# = Float(height Shr 1) - Float(y)
For x = 0 To width - 1
nx# = Float(width Shr 1) - Float(x)
dis# = Sqr(Float(nx# * nx#) + Float(ny# * ny#) + Float(nz# * nz#))
normalx#(x,y) = -Float(nx# / dis#)
normaly#(x,y) = Float(ny# / dis#)
normalz#(x,y) = Float(nz# / dis#)
Next
Next
End Function
Function raytrace()
Local argb
For y = 0 To height - 1
For x = 0 To width - 1
argb = ray(camerax#,cameray#,cameraz#,normalx#(x,y),normaly#(x,y),normalz#(x,y),256)
If argb <> $000000 Then WritePixelFast x,y,argb
Next
Next
End Function
Function ray(ex#,ey#,ez#,evx#,evy#,evz#,c)
If c <= 32 Then Return
Local plane.plane
Local sphere.sphere
Local z# = 10000
Local svx#
Local svy#
Local svz#
Local ix#
Local iy#
Local iz#
Local nx#
Local ny#
Local nz#
Local rnx#
Local rny#
Local rnz#
Local lvx#
Local lvy#
Local lvz#
Local dxis#
Local ydis#
Local zdis#
Local dxis2#
Local ydis2#
Local zdis2#
Local dis#
Local dis2#
Local l#
Local c1
Local c2
Local c3
Local r
Local g
Local b
For i = 0 To planes - 1
plane.plane = p(i)
nx# = plane\nx#
ny# = plane\ny#
nz# = plane\nz#
dis# = Float(Float(nx# * evx#) + Float(ny# * evy#) + Float(nz# * evz#))
If dis# < 0
dis2# = Float(-Float(plane\dis# + Float(Float(nx# * ex#) + Float(ny# * ey#) + Float(nz# * ez#))) / dis#)
ix# = ex# + Float(evx# * dis2#)
iy# = ey# + Float(evy# * dis2#)
iz# = ez# + Float(evz# * dis2#)
lvx# = Float(lightx# - ix#)
lvy# = Float(lighty# - iy#)
lvz# = Float(lightz# - iz#)
dis# = Sqr(Float(lvx# * lvx#) + Float(lvy# * lvy#) + Float(lvz# * lvz#))
lvx# = Float(lvx# / dis#)
lvy# = Float(lvy# / dis#)
lvz# = Float(lvz# / dis#)
l# = Float(Float(nx# * lvx#) + Float(ny# * lvy#) + Float(nz# * lvz#))
dis# = Float(Float(Float(nx# * evx#) + Float(ny# * evy#) + Float(nz# * evz#)) * 2.0)
rnx# = evx# - Float(nx# * dis#)
rny# = evy# - Float(ny# * dis#)
rnz# = evz# - Float(nz# * dis#)
c1 = Int(l# * 256.0)
c2 = Int(Float(Float(rnx# * lvx#) + Float(rny# * lvy#) + Float(rnz# * lvz#))^spec# * 256.0)
argb = plane\argb
z# = dis2#
EndIf
Next
For i = 0 To spheres - 1
sphere.sphere = s(i)
svx# = sphere\x# - ex#
svy# = sphere\y# - ey#
svz# = sphere\z# - ez#
dis2# = Float(Float(svx# * evx#) + Float(svy# * evy#) + Float(svz# * evz#))
dis# = Float(Float(svx# * svx#) + Float(svy# * svy#) + Float(svz# * svz#)) - Float(dis2# * dis2#)
If dis# <= sphererad2#
dis2# = dis2# - Sqr(sphererad2# - dis#)
If dis2# > 0 And dis2# < z#
ix# = ex# + Float(evx# * dis2#)
iy# = ey# + Float(evy# * dis2#)
iz# = ez# + Float(evz# * dis2#)
nx# = Float(Float(ix# - sphere\x#) / sphererad#)
ny# = Float(Float(iy# - sphere\y#) / sphererad#)
nz# = Float(Float(iz# - sphere\z#) / sphererad#)
lvx# = Float(lightx# - ix#)
lvy# = Float(lighty# - iy#)
lvz# = Float(lightz# - iz#)
dis# = Sqr(Float(lvx# * lvx#) + Float(lvy# * lvy#) + Float(lvz# * lvz#))
lvx# = Float(lvx# / dis#)
lvy# = Float(lvy# / dis#)
lvz# = Float(lvz# / dis#)
l# = Float(Float(nx# * lvx#) + Float(ny# * lvy#) + Float(nz# * lvz#))
dis# = Float(Float(Float(nx# * evx#) + Float(ny# * evy#) + Float(nz# * evz#)) * 2.0)
rnx# = evx# - Float(nx# * dis#)
rny# = evy# - Float(ny# * dis#)
rnz# = evz# - Float(nz# * dis#)
c1 = Int(l# * 256.0)
c2 = Int(Float(Float(rnx# * lvx#) + Float(rny# * lvy#) + Float(rnz# * lvz#))^spec# * 256.0)
argb = sphere\argb
z# = dis2#
EndIf
EndIf
Next
If shadowed(ix#,iy#,iz#)
c1 = 30
c2 = 0
Else
If c1 < 30 Then c1 = 30
If c2 < 0 Then c2 = 0
EndIf
c3 = (c1 * c) Shr 8
r = ((argb And $FF0000) * c3) Shr 8
g = ((argb And $00FF00) * c3) Shr 8
b = ((argb And $0000FF) * c3) Shr 8
r = r + (c2 Shl 16)
g = g + (c2 Shl 8)
b = b + c2
If argb <> $000000 Then argb = ray(ix#,iy#,iz#,rnx#,rny#,rnz#,c - 32)
r = r + (argb And $FF0000)
g = g + (argb And $00FF00)
b = b + (argb And $0000FF)
If r > $FF0000
r = $FF0000
Else
r = r And $FF0000
EndIf
If g > $00FF00
g = $00FF00
Else
g = g And $00FF00
EndIf
If b > $0000FF
b = $0000FF
Else
b = b And $0000FF
EndIf
Return r Or g Or b
End Function
Function shadowed(x#,y#,z#)
Local plane.plane
Local sphere.sphere
Local shad = False
Local evx# = Float(lightx# - x#)
Local evy# = Float(lighty# - y#)
Local evz# = Float(lightz# - z#)
Local dis# = Sqr(Float(evx# * evx#) + Float(evy# * evy#) + Float(evz# * evz#))
Local dis2#
evx# = Float(evx# / dis#)
evy# = Float(evy# / dis#)
evz# = Float(evz# / dis#)
For i = 0 To planes - 1
plane.plane = p(i)
nx# = plane\nx#
ny# = plane\ny#
nz# = plane\nz#
dis# = Float(Float(nx# * evx#) + Float(ny# * evy#) + Float(nz# * evz#))
If dis# < 0
shad = True
i = planes - 1
EndIf
Next
If shad = False
For i = 0 To spheres - 1
sphere.sphere = s(i)
svx# = sphere\x# - x#
svy# = sphere\y# - y#
svz# = sphere\z# - z#
dis2# = Float(Float(svx# * evx#) + Float(svy# * evy#) + Float(svz# * evz#))
dis# = Float(Float(svx# * svx#) + Float(svy# * svy#) + Float(svz# * svz#)) - Float(dis2# * dis2#)
If dis2# > 0 And dis# < sphererad2#
shad = True
i = spheres - 1
EndIf
Next
EndIf
Return shad
End Function
;-------------------------------------- Pre-Calc ---------------------------------------------------
Function PreCalculate()
Cls:Flip
For frame = 0 To 101-1
For y = 0 To height - 1
For x = 0 To width - 1
argb = ray(camerax#,cameray#,cameraz#,normalx#(x,y),normaly#(x,y),normalz#(x,y),256)
If argb <> $000000 Then buffer(frame,x,y) = argb
Next
Next
For i = 0 To spheres - 1
s(i)\x# = s(i)\x# + s(i)\xv#
s(i)\y# = s(i)\y# + s(i)\yv#
s(i)\z# = s(i)\z# + s(i)\zv#
s(i)\yv# = s(i)\yv# - grav#
If s(i)\y# - sphererad# < -p(0)\dis#
s(i)\y# = -p(0)\dis# + sphererad#
s(i)\xv# = (s(i)\xv# * fric#)
s(i)\yv# = (-s(i)\yv# * fric#)
s(i)\zv# = (s(i)\zv# * fric#)
If s(i)\xv# > -fric# Or s(i)\xv# < fric# Then s(i)\xv# = 0
If s(i)\zv# > -fric# Or s(i)\zv# < fric# Then s(i)\zv# = 0
EndIf
Next
Cls
cnt = cnt + 1
Text 70,100,"Wait a moment..."
Text 200,100,cnt + "%"
Flip
Next
End Function
;------------------------ "Frame Per Second" -------------------------
Function FPS_Count(xpos,ypos,fr,fg,fb)
Color fr,fg,fb
If bSettime = True
iSecStart = MilliSecs()
iFrameStart = iFrameCount
bSettime = False
EndIf
If MilliSecs() >= iSecStart + 1000
iFPS = iFrameCount - iFrameStart
bSettime = True
EndIf
iFrameCount = iFrameCount + 1
; If KeyDown(57) Then
Text xpos,ypos,"FPS: " + Str iFPS
End Function
Excellent !!!! lol i will try to convert it under bmax soon
Dang, good idea Rbraz.
Gives me food for thought.
Lots of demos have precalc stuff in them, you could show a picture or something, or calculate it during static text displays if you wanted to have a ray traced part to a demo.
Very good !!!!!!!! Very good Effort as it ran 20FPS on my computer...
welldone
Very good !!!!!!!! Thanks for the speedup RBraz!
But I will still refrain from precalc in my demos; I like the raw speed better.
Hey guys,
REALLY glad you all enjoyed looking at this dumb little thing!
Filax, sorry, no light color changes. PM me if you wanna know how to code some.
Same with camera rotation; none.
Also I'm having trouble adding triangles into the mix; there's so much math involved that I frequently get lost in code and forget what I'm doing .
Anyway, I'm thinking of writing a tutorial in a few weeks on the subject.
I hope To have your new one about this !!
I have One question : Is it possible to change the camera pointing and rotation ?
Finally got polygons into the tracer. I won't put the code up yet, as it's too files; I load the scene seperately now.
Filax: It is possible, but not with that code. I know exactly how, and could teach you, tho.
Just PM me.
Awesome Damn,
That is honestly one of the coolest programs I've ever seen! It's too bad real-time raytracing is so slow, I think the effect is much sharper than the standard 3d methods. This is definately one thing I would like to try my hand at! I think I could do it too -- Because as far as I know(correct me please if I'm wrong) Isn't ray tracing just like raycasting -- Except that you cast rays for the entire screen, Rather than just the width of the screen? Like with raycasting on a 320 by 240 screen, You would only cast 320 rays, Where-as with raytracing, You would cast 320 times 240 rays right? Of course to get the lighting effects I'm sure takes a lot more calculations, But the basic effect would be like I described correct? Anywayz, Awesome job!
-Grim-
Awesome Grim,
Yes, in raytracing you shoot a ray for every pixel on the screen, and if it hits an object, you figure out where it hit, the normal for that point, if it's shadowed, lighting, reflected rays, things like that. But the intersections are much more complicated in raytracing than raycasting, because in raycasting walls are always perpendicular to the floor.
But once you code a raycaster, it makes things like raytracing much simpler.
