Hi :) I have find a little B3D program on the DBF forum
http://p212.ezboard.com/fdbffrm50.showMessage?topicID=190.topic
http://p212.ezboard.com/fdbffrm50.showMessage?topicID=190.topic
RealTime Raytracing in bmax
BlitzMax Forums/BlitzMax Programming/RealTime Raytracing in bmax Try this:
' -------------------------------------------------- ' The color rendering is bugged here i dn't know why ' -------------------------------------------------- c3 = (c1 * c) Shr 8 'a = ((argb & $FF000000) * c3) Shr 8 r = ((argb & $00FF0000) * c3) Shr 8 g = ((argb & $0000FF00) * c3) Shr 8 b = ((argb & $000000FF) * c3) Shr 8 'a = a + (c2 Shl 24) r = r + (c2 Shl 16) g = g + (c2 Shl 8) b = b + c2 If argb <> $FF000000 Then argb = ray(ix#,iy#,iz#,rnx#,rny#,rnz#,c - 32) 'a = a + (argb & $FF000000) 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
Excellent ! here is the full code
** ADMIN REMOVE THIS **
** ADMIN REMOVE THIS **
** ADMIN REMOVE THIS **
I have find a little stuff to antialias quickly images :) it's not very very
clean, but better than a pixelated image
I compute my image and before draw i make a setscale to reduce the
size a little bit ... :)
Look this example (Thygrion from DBF) that i have translate to work
with bmax.
Framework BRL.GLMax2D
Import BRL.Random
SetGraphicsDriver GLMax2DDriver()
Const width = 320
Const height = 240
Graphics width,height,32,75
SeedRnd MilliSecs()
Global RenderImage:Timage=CreateImage(width,height,DYNAMICIMAGE)
MidHandleImage(RenderIMage)
Global sphere_list:TList=New TList
Global plane_list:TList=New TList
Type TBBType
Field _list:TList
Field _link:TLink
Method Remove()
_list.remove Self
End Method
End Type
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
' ---------------
' FPS Counter var
' ---------------
Global Frames:Int
Global RenderTime:Int
Global Fps:Int
' ---------
' Other var
' ,--------
Global planes = 1
Global spheres = 4
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# = 80.0
Global sphererad2# = Float(sphererad# * sphererad#)
Global camerax# =0
Global cameray# =0
Global cameraz# = -800.0
Global lightx# = 200.0
Global lighty# = 400.0
Global lightz# = -200.0
Global spec# = 90.0
Global grav# = 1.15
Global fric# = 0.65
' --------------
' Setup 3D scene
' --------------
DrawText "COMPUTING",10,10
Flip
setupplanes()
setupspheres()
setupnormals()
Global RenderScale#=0.90
While Not KeyHit(KEY_ESCAPE)
Cls
raytrace()
SetScale RenderScale#,RenderScale#
DrawImage RenderIMage,GraphicsWidth()/2,GraphicsHeight()/2
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#
' ---------------------------------------
' Detecting if the sphere touch the plane
' ---------------------------------------
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(KEY_LEFT) Then camerax# = camerax# - 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
If KeyDown(KEY_PAGEUP) Then cameray# = cameray# + 50.0
If KeyDown(KEY_PAGEDOWN) Then cameray# = cameray# - 50.0
' --------------------
' Made jump the sphere
' --------------------
If KeyHit(KEY_SPACE)
For i = 0 To spheres - 1
s(i).yv# = Rnd(16,20)
Next
EndIf
DrawText "FPS "+Fps+" / "+MemUsage(),10,10
RefreshFPS()
FlushMem
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).argb = Rand($686868,$FFFFFF)
Next
End Function
' ----------------------
' Setup sphere primitive
' ----------------------
Function setupspheres()
Local sr# = Float(sphererad# * 4.5)
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)
Next
End Function
Function setupnormals()
Local nx#
Local ny#
Local nz# = 250.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
Local RenderMap=LockImage(RenderImage)
For y = 0 To ImageHeight(RenderImage) - 1
For x = 0 To ImageWidth(RenderImage)- 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# < 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: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# < 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 & $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 - 82)
If argb <> $00000000 Then argb = ray(ix#,iy#,iz#,rnx#,rny#,rnz#,c - 95)
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# < 0
shad = True
i = planes - 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# < sphererad2#
shad = True
i = spheres - 1
EndIf
Next
EndIf
Return shad
End Function
' ------------
' For know FPS
' ------------
Function RefreshFPS()
Frames=Frames+1
If MilliSecs()-RenderTime=>1000 Then
Fps=Frames
Frames=0
RenderTime=MilliSecs()
EndIf
End Function
clean, but better than a pixelated image
I compute my image and before draw i make a setscale to reduce the
size a little bit ... :)
Look this example (Thygrion from DBF) that i have translate to work
with bmax.
Framework BRL.GLMax2D
Import BRL.Random
SetGraphicsDriver GLMax2DDriver()
Const width = 320
Const height = 240
Graphics width,height,32,75
SeedRnd MilliSecs()
Global RenderImage:Timage=CreateImage(width,height,DYNAMICIMAGE)
MidHandleImage(RenderIMage)
Global sphere_list:TList=New TList
Global plane_list:TList=New TList
Type TBBType
Field _list:TList
Field _link:TLink
Method Remove()
_list.remove Self
End Method
End Type
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
' ---------------
' FPS Counter var
' ---------------
Global Frames:Int
Global RenderTime:Int
Global Fps:Int
' ---------
' Other var
' ,--------
Global planes = 1
Global spheres = 4
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# = 80.0
Global sphererad2# = Float(sphererad# * sphererad#)
Global camerax# =0
Global cameray# =0
Global cameraz# = -800.0
Global lightx# = 200.0
Global lighty# = 400.0
Global lightz# = -200.0
Global spec# = 90.0
Global grav# = 1.15
Global fric# = 0.65
' --------------
' Setup 3D scene
' --------------
DrawText "COMPUTING",10,10
Flip
setupplanes()
setupspheres()
setupnormals()
Global RenderScale#=0.90
While Not KeyHit(KEY_ESCAPE)
Cls
raytrace()
SetScale RenderScale#,RenderScale#
DrawImage RenderIMage,GraphicsWidth()/2,GraphicsHeight()/2
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#
' ---------------------------------------
' Detecting if the sphere touch the plane
' ---------------------------------------
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(KEY_LEFT) Then camerax# = camerax# - 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
If KeyDown(KEY_PAGEUP) Then cameray# = cameray# + 50.0
If KeyDown(KEY_PAGEDOWN) Then cameray# = cameray# - 50.0
' --------------------
' Made jump the sphere
' --------------------
If KeyHit(KEY_SPACE)
For i = 0 To spheres - 1
s(i).yv# = Rnd(16,20)
Next
EndIf
DrawText "FPS "+Fps+" / "+MemUsage(),10,10
RefreshFPS()
FlushMem
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).argb = Rand($686868,$FFFFFF)
Next
End Function
' ----------------------
' Setup sphere primitive
' ----------------------
Function setupspheres()
Local sr# = Float(sphererad# * 4.5)
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)
Next
End Function
Function setupnormals()
Local nx#
Local ny#
Local nz# = 250.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
Local RenderMap=LockImage(RenderImage)
For y = 0 To ImageHeight(RenderImage) - 1
For x = 0 To ImageWidth(RenderImage)- 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# < 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: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# < 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 & $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 - 82)
If argb <> $00000000 Then argb = ray(ix#,iy#,iz#,rnx#,rny#,rnz#,c - 95)
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# < 0
shad = True
i = planes - 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# < sphererad2#
shad = True
i = spheres - 1
EndIf
Next
EndIf
Return shad
End Function
' ------------
' For know FPS
' ------------
Function RefreshFPS()
Frames=Frames+1
If MilliSecs()-RenderTime=>1000 Then
Fps=Frames
Frames=0
RenderTime=MilliSecs()
EndIf
End Function
Filax,
Runs 10 fps quicker than the last version for me - well done!
Runs 10 fps quicker than the last version for me - well done!