But my french is only good enough to get slapped for. :roll:
PureRay - Realtime Raytracing Demo
-
DarkDragon
- Addict

- Posts: 2347
- Joined: Mon Jun 02, 2003 9:16 am
- Location: Germany
- Contact:
-
dracflamloc
- Addict

- Posts: 1648
- Joined: Mon Sep 20, 2004 3:52 pm
- Contact:
fairly smooth on my machine, though i notice some 'sqaureish' artifacts at the bottom of the green ball
( PB6.00 LTS Win11 x64 Asrock AB350 Pro4 Ryzen 5 3600 32GB GTX1060 6GB - upgrade incoming...)
( The path to enlightenment and the PureBasic Survival Guide right here... )
( The path to enlightenment and the PureBasic Survival Guide right here... )
Here is a slightly changed version. The changes are minor and trivial but...
First off, a few While's was replaced with ForEach
which saves a few NextElement()'s that was used and should give a minimal speedup. And also eliminates the need for ResetList() as well.
(Tip: try to use array instead of lists, should give even more speedup)
Also added a fps/time result at end, so now you peeps can compare ho big your...
Oh yeah, also slapped on DisableDebugger at start for those really lazy people
Love your code Hades
First off, a few While's was replaced with ForEach
which saves a few NextElement()'s that was used and should give a minimal speedup. And also eliminates the need for ResetList() as well.
(Tip: try to use array instead of lists, should give even more speedup)
Also added a fps/time result at end, so now you peeps can compare ho big your...
Oh yeah, also slapped on DisableDebugger at start for those really lazy people
Love your code Hades
Code: Select all
;-------------------------------------------------------------------------------------------------------------------------
;
; PureRay
;
; Realtime Raytracing Interactive Demo
; for Windows PB4.0 (Beta 5)
;
; by Hades
;
; March 2006
;
;
; WSAD or Cursor keys for movement
; Space : Reset Camera
; 1-5 : Subdivision resolution
;
;-------------------------------------------------------------------------------------------------------------------------
DisableDebugger
EnableExplicit
Macro Error(Message)
MessageRequester("Error!", Message + #CRLF$ + "File: " + #PB_Compiler_File + #CRLF$ + "Line: " + Str(#PB_Compiler_Line))
EndMacro
#GL_MODELVIEW = $1700
#GL_PROJECTION = $1701
#GL_POINTS = $0000
#GL_QUADS = $0007
#GL_DEPTH_TEST = $0B71
#EPSILON = 0.000001
Declare CheckQuad(PosX.l, PosY.l, Res.l)
Structure sVECTOR
x.f
y.f
z.f
EndStructure
Structure sDVECTOR
x.f
y.f
z.f
EndStructure
Structure sCOLOR
r.f
g.f
b.f
EndStructure
Structure sMATRIX
m11.f : m12.f : m13.f : m14.f
m21.f : m22.f : m23.f : m24.f
m31.f : m32.f : m33.f : m34.f
m41.f : m42.f : m43.f : m44.f
EndStructure
Structure sVSCREEN
TopLeft.sVECTOR
TopRight.sVECTOR
BottomLeft.sVECTOR
BottomRight.sVECTOR
EndStructure
Global Lens.sVSCREEN
Structure sCAMERA
pos.sVECTOR
Speed.sVECTOR
Accel.f
Strafe.f
rotX.f
rotY.f
matRot.sMATRIX
Screen.sVSCREEN
EndStructure
Global Camera.sCAMERA
Structure sMATERIAL
r.f
g.f
b.f
Reflect.f
Specular.f
Gloss.l
EndStructure
Global NewList Material.sMATERIAL()
Structure sOBJECT
Origin.sVECTOR
radius.f
Material.l
EndStructure
Global NewList Object.sOBJECT()
Structure sLIGHT
pos.sVECTOR
r.f
g.f
b.f
Decline.f
EndStructure
Global NewList Light.sLIGHT()
Structure sSCREEN
Frame.l
r.f
g.f
b.f
tlf.f
trf.f
blf.f
brf.f
EndStructure
Global Dim Screen.sSCREEN(0,0)
Global hdc
Global ScrWidth.l = 800
Global ScrHeight.l = 600
Global Frame.l
Global FrameTime.f = 0.1
Global Resolution.l = 8
Global Dim Key.l(255)
Procedure EventCheckKeys(Event.l)
If Event = #WM_KEYDOWN
Key(EventwParam()) = #True
ElseIf Event = #WM_KEYUP
Key(EventwParam()) = #False
EndIf
EndProcedure
Procedure InitGameTimer()
Shared _GT_DevCaps.TIMECAPS
timeGetDevCaps_(_GT_DevCaps,SizeOf(TIMECAPS))
timeBeginPeriod_(_GT_DevCaps\wPeriodMin)
EndProcedure
Procedure VSyncState(State) ;0=off/1=on
Protected wglSwapIntervalEXT.l
wglSwapIntervalEXT = wglGetProcAddress_("wglSwapIntervalEXT")
If wglSwapIntervalEXT
CallFunctionFast(wglSwapIntervalEXT, State)
Else
Error("wglSwapIntervalEXT not found")
EndIf
EndProcedure
Procedure MatrixIdentity(*Matrix.sMATRIX)
*Matrix\m11 = 1.0 : *Matrix\m12 = 0.0 : *Matrix\m13 = 0.0 : *Matrix\m14 = 0.0
*Matrix\m21 = 0.0 : *Matrix\m22 = 1.0 : *Matrix\m23 = 0.0 : *Matrix\m24 = 0.0
*Matrix\m31 = 0.0 : *Matrix\m32 = 0.0 : *Matrix\m33 = 1.0 : *Matrix\m34 = 0.0
*Matrix\m41 = 0.0 : *Matrix\m42 = 0.0 : *Matrix\m43 = 0.0 : *Matrix\m44 = 1.0
EndProcedure
Procedure MatrixRotateX(*Matrix.sMATRIX, Angle.f)
Protected Help.f, tsin.f, tcos.f
tsin.f = Sin(Angle)
tcos.f = Cos(Angle)
Help = *Matrix\m21 * tcos + *Matrix\m31 * tsin
*Matrix\m31 = *Matrix\m21 * -tsin + *Matrix\m31 * tcos
*Matrix\m21 = Help
Help = *Matrix\m22 * tcos + *Matrix\m32 * tsin
*Matrix\m32 = *Matrix\m22 * -tsin + *Matrix\m32 * tcos
*Matrix\m22 = Help
Help = *Matrix\m23 * tcos + *Matrix\m33 * tsin
*Matrix\m33 = *Matrix\m23 * -tsin + *Matrix\m33 * tcos
*Matrix\m23 = Help
;Help = *Matrix\m24 * tcos + *Matrix\m34 * tsin
;*Matrix\m34 = *Matrix\m24 * -tsin + *Matrix\m34 * tcos
;*Matrix\m24 = Help
EndProcedure
Procedure MatrixRotateY(*Matrix.sMATRIX, Angle.f)
Protected Help.f, tsin.f, tcos.f
tsin.f = Sin(Angle)
tcos.f = Cos(Angle)
Help = *Matrix\m11 * tcos - *Matrix\m31 * tsin
*Matrix\m31 = *Matrix\m11 * tsin + *Matrix\m31 * tcos
*Matrix\m11 = Help
Help = *Matrix\m12 * tcos - *Matrix\m32 * tsin
*Matrix\m32 = *Matrix\m12 * tsin + *Matrix\m32 * tcos
*Matrix\m12 = Help
Help = *Matrix\m13 * tcos - *Matrix\m33 * tsin
*Matrix\m33 = *Matrix\m13 * tsin + *Matrix\m33 * tcos
*Matrix\m13 = Help
;Help = *Matrix\m14 * tcos - *Matrix\m34 * tsin
;*Matrix\m34 = *Matrix\m14 * tsin + *Matrix\m34 * tcos
;*Matrix\m14 = Help
EndProcedure
Procedure MatrixVectorRotation(*out.sVECTOR, *Vector.sVECTOR, *Matrix.sMATRIX)
Protected TempX.f, TempY.f
TempX = *Matrix\m11 * *Vector\x + *Matrix\m21 * *Vector\y + *Matrix\m31 * *Vector\z
TempY = *Matrix\m12 * *Vector\x + *Matrix\m22 * *Vector\y + *Matrix\m32 * *Vector\z
*out\z = *Matrix\m13 * *Vector\x + *Matrix\m23 * *Vector\y + *Matrix\m33 * *Vector\z
*out\x = TempX
*out\y = TempY
EndProcedure
Procedure.l AddMaterial(red.f, green.f, blue.f, Reflect.f = 0.0, Specular.f = 0.3, Gloss.l = 20)
AddElement(Material())
Material()\r = red
Material()\g = green
Material()\b = blue
Material()\Reflect = Reflect
Material()\Specular = Specular
Material()\Gloss = Gloss
ProcedureReturn @Material()
EndProcedure
Procedure AddLight(x.f, y.f, z.f, red.f = 1.0, green.f = 1.0, blue.f = 1.0, Decline.f = 1.0)
AddElement(Light())
Light()\pos\x = x
Light()\pos\y = y
Light()\pos\y = y
Light()\r = red
Light()\g = green
Light()\b = blue
Light()\Decline = Decline
EndProcedure
Procedure AddSphere(x.f, y.f, z.f, radius.f, Material.l)
AddElement(Object())
Object()\Origin\x = x
Object()\Origin\y = y
Object()\Origin\z = z
Object()\radius = radius
Object()\Material = Material
EndProcedure
Procedure.f TestSphere(*Origin.sVECTOR, *Direction.sVECTOR, *Sphere.sOBJECT)
Protected offset.sVECTOR, radius.f, b.f, c.f, d.f, t1.f, t2.f
offset\x=*Origin\x - *Sphere\Origin\x
offset\y=*Origin\y - *Sphere\Origin\y
offset\z=*Origin\z - *Sphere\Origin\z
radius = *Sphere\radius
b = (*Direction\x * offset\x + *Direction\y * offset\y + *Direction\z * offset\z)
c = (offset\x * offset\x + offset\y * offset\y + offset\z * offset\z) - radius * radius
d = b * b - c
If d > 0.0
d=Sqr(d)
t1 = (-b - d)
t2 = (-b + d)
If t2 < t1 And t2 > 0.0
ProcedureReturn t2
Else
ProcedureReturn t1
EndIf
EndIf
ProcedureReturn -1.0
EndProcedure
Procedure glOrtho(left.d, right.d, bottom.d, top.d, Near.d, Far.d)
Protected Dim Ortho_Matrix.d(3, 3)
Ortho_Matrix(0, 0) = 2.0/(right-left )
Ortho_Matrix(1, 1) = 2.0/(top -bottom)
Ortho_Matrix(2, 2) = -2.0/(Far -Near )
Ortho_Matrix(3, 3) = 1.0
Ortho_Matrix(3, 0) = -1.0*(right+left)/(right-left)
Ortho_Matrix(3, 1) = -1.0*(top+bottom)/(top-bottom)
Ortho_Matrix(3, 2) = -1.0*(Far+Near )/(Far-Near )
ProcedureReturn glMultMatrixd_(@Ortho_Matrix(0, 0))
EndProcedure
Procedure.l ScreenOpen(Width.l = 0, Height.l = 0, Name.s = "OpenGL Screen")
If Width=0 And Height=0
Width=GetSystemMetrics_(#SM_CXSCREEN)
Height=GetSystemMetrics_(#SM_CYSCREEN)
EndIf
If OpenWindow(1, 0, 0, Width, Height, #WS_POPUP | #WS_CLIPCHILDREN | #WS_CLIPSIBLINGS, Name)
Protected hwnd.l
hwnd = WindowID(1)
Protected dmScreenSettings.DEVMODE
dmScreenSettings\dmSize = SizeOf(DEVMODE)
dmScreenSettings\dmPelsWidth = Width
dmScreenSettings\dmPelsHeight = Height
dmScreenSettings\dmBitsPerPel = 32
dmScreenSettings\dmFields = 262144 | 524288 | 1048576
If ChangeDisplaySettings_(@dmScreenSettings, 4) = 0
Protected pfd.PIXELFORMATDESCRIPTOR
hdc = GetDC_(hwnd)
pfd\nSize = SizeOf(PIXELFORMATDESCRIPTOR)
pfd\nVersion = 1
pfd\dwFlags = #PFD_SUPPORT_OPENGL | #PFD_DOUBLEBUFFER | #PFD_DRAW_TO_WINDOW
pfd\iLayerType = #PFD_MAIN_PLANE
pfd\iPixelType = #PFD_TYPE_RGBA
pfd\cColorBits = 32
pfd\cDepthBits = 32
Protected pixformat.l
pixformat = ChoosePixelFormat_(hdc, pfd)
SetPixelFormat_(hdc, pixformat, pfd)
Protected hrc.l
hrc = wglCreateContext_(hdc)
wglMakeCurrent_(hdc, hrc)
SwapBuffers_(hdc)
Else
Error("Unable to change display settings to w,h,d: "+Str(Width)+"," +Str(Height)+"," +Str(dmScreenSettings\dmBitsPerPel))
EndIf
Else
Error("Unable to open window w,h: "+Str(Width)+"," +Str(Height))
EndIf
ProcedureReturn
EndProcedure
Procedure Trace(*Origin.sVECTOR, *Dir.sVECTOR, *Col.sCOLOR, Bounce.l = 0)
Protected NormDir.sVECTOR, f.f, *hitObj.sOBJECT, hitDist.f, Shadow.l
Protected Intersect.sVECTOR, Normal.sVECTOR, LightVec.sVECTOR, LightDist.f, dot.f, Hit.f
Protected red.f, green.f, blue.f, ReflVec.sVECTOR, ReflOrigin.sVECTOR, RefCol.sCOLOR, tempvec.sVECTOR
Protected offset.sVECTOR, b.f, c.f, d.f, t1.f, t2.f, r.f, spec.f, *Material.sMATERIAL
hitDist = 1000000.0
ForEach Object()
Hit = -1
offset\x = *Origin\x - Object()\Origin\x
offset\y = *Origin\y - Object()\Origin\y
offset\z = *Origin\z - Object()\Origin\z
b = (*Dir\x * offset\x + *Dir\y * offset\y + *Dir\z * offset\z)
c = (offset\x * offset\x + offset\y * offset\y + offset\z * offset\z) - Object()\radius * Object()\radius
d = b * b - c
If d > 0.0
d=Sqr(d)
t1 = (-b - d)
t2 = (-b + d)
If t2 < t1 And t2 > 0.0
Hit = t2
Else
Hit = t1
EndIf
EndIf
If Hit > 0.0
If Hit < hitDist
hitDist = Hit
*hitObj = @Object()
EndIf
EndIf
Next
If *hitObj
*Material = *hitObj\Material
Intersect\x = *Origin\x + *Dir\x * hitDist
Intersect\y = *Origin\y + *Dir\y * hitDist
Intersect\z = *Origin\z + *Dir\z * hitDist
Normal\x = (Intersect\x - *hitObj\Origin\x) / *hitObj\radius
Normal\y = (Intersect\y - *hitObj\Origin\y) / *hitObj\radius
Normal\z = (Intersect\z - *hitObj\Origin\z) / *hitObj\radius
ForEach Light()
LightVec\x = Light()\pos\x - Intersect\x
LightVec\y = Light()\pos\y - Intersect\y
LightVec\z = Light()\pos\z - Intersect\z
LightDist = Sqr(LightVec\x * LightVec\x + LightVec\y * LightVec\y + LightVec\z * LightVec\z)
LightVec\x = LightVec\x / LightDist
LightVec\y = LightVec\y / LightDist
LightVec\z = LightVec\z / LightDist
Shadow = #False
ForEach Object()
If *hitObj <> @Object()
offset\x = Intersect\x - Object()\Origin\x
offset\y = Intersect\y - Object()\Origin\y
offset\z = Intersect\z - Object()\Origin\z
b = (LightVec\x * offset\x + LightVec\y * offset\y + LightVec\z * offset\z)
c = (offset\x * offset\x + offset\y * offset\y + offset\z * offset\z) - Object()\radius * Object()\radius
d = b * b - c
If d > 0.0
d = Sqr(d)
t1 = (-b - d)
t2 = (-b + d)
If t1 > 0.0 Or t2 > 0.0
Shadow = #True
Break
EndIf
EndIf
EndIf
Next
If Not Shadow
dot = Normal\x * LightVec\x + Normal\y * LightVec\y + Normal\z * LightVec\z
If dot > 0.0
*Col\r + dot * Light()\r * *Material\r
*Col\g + dot * Light()\g * *Material\g
*Col\b + dot * Light()\b * *Material\b
EndIf
If *Material\Specular > 0.0
tempvec\x = LightVec\x - 2 * dot * Normal\x
tempvec\y = LightVec\y - 2 * dot * Normal\y
tempvec\z = LightVec\z - 2 * dot * Normal\z
dot = *Dir\x * tempvec\x + *Dir\y * tempvec\y + *Dir\z * tempvec\z
If dot>0
;spec = Pow(dot, *Material\Gloss) * *Material\Specular
spec = (dot / (*Material\Gloss - dot * *Material\Gloss + dot)) * *Material\Specular
*Col\r + Light()\r * spec
*Col\g + Light()\g * spec
*Col\b + Light()\b * spec
EndIf
EndIf
EndIf
Next
If Bounce < 3
If *Material\Reflect > 0.0
r = *Dir\x * Normal\x + *Dir\y * Normal\y + *Dir\z * Normal\z
ReflVec\x = *Dir\x - 2 * r * Normal\x
ReflVec\y = *Dir\y - 2 * r * Normal\y
ReflVec\z = *Dir\z - 2 * r * Normal\z
ReflOrigin\x = Intersect\x + ReflVec\x * #EPSILON
ReflOrigin\y = Intersect\y + ReflVec\y * #EPSILON
ReflOrigin\z = Intersect\z + ReflVec\z * #EPSILON
Trace(ReflOrigin, ReflVec, RefCol, Bounce + 1)
*Col\r + *Material\Reflect * RefCol\r
*Col\g + *Material\Reflect * RefCol\g
*Col\b + *Material\Reflect * RefCol\b
EndIf
EndIf
EndIf
EndProcedure
Procedure Ray(ScrX.l, ScrY.l, *Origin.sVECTOR, *Dir.sVECTOR)
Protected Col.sCOLOR
Screen(ScrX, ScrY)\Frame = Frame
Trace(*Origin, *Dir, Col)
Screen(ScrX,ScrY)\r = Col\r
Screen(ScrX,ScrY)\g = Col\g
Screen(ScrX,ScrY)\b = Col\b
EndProcedure
Procedure DrawQuad(ScrX.l, ScrY.l, Res.l)
Protected px.l, py.l
glBegin_(#GL_QUADS)
px = ScrX - Res : py = ScrY - Res
glColor3f_(Screen(px, py)\r, Screen(px, py)\g, Screen(px, py)\b)
glVertex2i_(px, py)
px = ScrX : py = ScrY - Res
glColor3f_(Screen(px, py)\r, Screen(px, py)\g, Screen(px, py)\b)
glVertex2i_(px, py)
px = ScrX : py = ScrY
glColor3f_(Screen(px, py)\r, Screen(px, py)\g, Screen(px, py)\b)
glVertex2i_(px, py)
px = ScrX - Res : py = ScrY
glColor3f_(Screen(px, py)\r, Screen(px, py)\g, Screen(px, py)\b)
glVertex2i_(px, py)
glEnd_()
EndProcedure
Procedure Refine(PosX.l, PosY.l, Res.l)
Protected ScrX.l, ScrY.l, dir.sVECTOR
Protected ResNew.l
ResNew = Res >> 1
ScrX = PosX - Res
ScrY = PosY - ResNew
If Screen(ScrX, ScrY)\Frame <> Frame
dir\x = Camera\Screen\TopLeft\x * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\x * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\x * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\x * Screen(ScrX, ScrY)\brf
dir\y = Camera\Screen\TopLeft\y * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\y * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\y * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\y * Screen(ScrX, ScrY)\brf
dir\z = Camera\Screen\TopLeft\z * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\z * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\z * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\z * Screen(ScrX, ScrY)\brf
Ray(ScrX, ScrY, Camera\pos, dir)
EndIf
ScrX = PosX - ResNew
ScrY = PosY - Res
If Screen(ScrX, ScrY)\Frame <> Frame
dir\x = Camera\Screen\TopLeft\x * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\x * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\x * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\x * Screen(ScrX, ScrY)\brf
dir\y = Camera\Screen\TopLeft\y * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\y * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\y * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\y * Screen(ScrX, ScrY)\brf
dir\z = Camera\Screen\TopLeft\z * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\z * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\z * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\z * Screen(ScrX, ScrY)\brf
Ray(ScrX, ScrY, Camera\pos, dir)
EndIf
ScrY = PosY - ResNew
dir\x = Camera\Screen\TopLeft\x * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\x * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\x * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\x * Screen(ScrX, ScrY)\brf
dir\y = Camera\Screen\TopLeft\y * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\y * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\y * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\y * Screen(ScrX, ScrY)\brf
dir\z = Camera\Screen\TopLeft\z * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\z * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\z * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\z * Screen(ScrX, ScrY)\brf
Ray(ScrX, ScrY, Camera\pos, dir)
ScrY = PosY
dir\x = Camera\Screen\TopLeft\x * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\x * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\x * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\x * Screen(ScrX, ScrY)\brf
dir\y = Camera\Screen\TopLeft\y * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\y * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\y * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\y * Screen(ScrX, ScrY)\brf
dir\z = Camera\Screen\TopLeft\z * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\z * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\z * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\z * Screen(ScrX, ScrY)\brf
Ray(ScrX, ScrY, Camera\pos, dir)
ScrX = PosX
ScrY = PosY - ResNew
dir\x = Camera\Screen\TopLeft\x * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\x * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\x * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\x * Screen(ScrX, ScrY)\brf
dir\y = Camera\Screen\TopLeft\y * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\y * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\y * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\y * Screen(ScrX, ScrY)\brf
dir\z = Camera\Screen\TopLeft\z * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\z * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\z * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\z * Screen(ScrX, ScrY)\brf
Ray(ScrX, ScrY, Camera\pos, dir)
CheckQuad(PosX - ResNew, PosY - ResNew, ResNew)
CheckQuad(PosX, PosY - ResNew, ResNew)
CheckQuad(PosX - ResNew, PosY, ResNew)
CheckQuad(PosX, PosY, ResNew)
EndProcedure
Procedure.l CheckQuad(PosX.l, PosY.l, Res.l)
Protected result.l, ColErr.f, px.l, py.l
ColErr = Abs(Screen(PosX, PosY)\r - Screen(PosX - Res, PosY)\r) + Abs(Screen(PosX, PosY)\r - Screen(PosX, PosY - Res)\r) + Abs(Screen(PosX, PosY)\r - Screen(PosX - Res, PosY - Res)\r)
ColErr + Abs(Screen(PosX, PosY)\g - Screen(PosX - Res, PosY)\g) + Abs(Screen(PosX, PosY)\g - Screen(PosX, PosY - Res)\g) + Abs(Screen(PosX, PosY)\g - Screen(PosX - Res, PosY - Res)\g)
ColErr + Abs(Screen(PosX, PosY)\b - Screen(PosX - Res, PosY)\b) + Abs(Screen(PosX, PosY)\b - Screen(PosX, PosY - Res)\b) + Abs(Screen(PosX, PosY)\b - Screen(PosX - Res, PosY - Res)\b)
If Res = 1
glBegin_(#GL_POINTS)
px = PosX - Res : py = PosY
glColor3f_(Screen(px, py)\r, Screen(px, py)\g, Screen(px, py)\b)
glVertex2i_(px, py)
glEnd_()
Else
If ColErr > 0.1
Refine(PosX, PosY, Res)
Else
DrawQuad(PosX, PosY, Res)
EndIf
EndIf
ProcedureReturn result
EndProcedure
Procedure ShootRays(Res.l)
Protected ScrX.l, ScrY.l, dir.sVECTOR
ScrY = 0
While ScrY <= ScrHeight
dir\x = Camera\Screen\TopLeft\x * Screen(0, ScrY)\tlf + Camera\Screen\BottomLeft\x * Screen(0, ScrY)\blf
dir\y = Camera\Screen\TopLeft\y * Screen(0, ScrY)\tlf + Camera\Screen\BottomLeft\y * Screen(0, ScrY)\blf
dir\z = Camera\Screen\TopLeft\z * Screen(0, ScrY)\tlf + Camera\Screen\BottomLeft\z * Screen(0, ScrY)\blf
Ray(0, ScrY, Camera\pos, dir)
ScrY + Res
Wend
ScrX = 0
While ScrX <= ScrWidth
dir\x = Camera\Screen\TopLeft\x * Screen(ScrX, 0)\tlf + Camera\Screen\TopRight\x * Screen(ScrX, 0)\trf
dir\y = Camera\Screen\TopLeft\y * Screen(ScrX, 0)\tlf + Camera\Screen\TopRight\y * Screen(ScrX, 0)\trf
dir\z = Camera\Screen\TopLeft\z * Screen(ScrX, 0)\tlf + Camera\Screen\TopRight\z * Screen(ScrX, 0)\trf
Ray(ScrX, 0, Camera\pos, dir)
ScrX + Res
Wend
ScrY = Res
While ScrY <= ScrHeight
ScrX = Res
While ScrX <= ScrWidth
dir\x = Camera\Screen\TopLeft\x * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\x * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\x * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\x * Screen(ScrX, ScrY)\brf
dir\y = Camera\Screen\TopLeft\y * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\y * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\y * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\y * Screen(ScrX, ScrY)\brf
dir\z = Camera\Screen\TopLeft\z * Screen(ScrX, ScrY)\tlf + Camera\Screen\TopRight\z * Screen(ScrX, ScrY)\trf + Camera\Screen\BottomLeft\z * Screen(ScrX, ScrY)\blf + Camera\Screen\BottomRight\z * Screen(ScrX, ScrY)\brf
Ray(ScrX, ScrY, Camera\pos, dir)
CheckQuad(ScrX, ScrY, Res)
ScrX + Res
Wend
ScrY + Res
Wend
EndProcedure
Procedure SetupCamera()
Protected ScrX.l, ScrY.l, yInc.d, xInc.d, yFac.d, xFac.d, tlf.d, trf.d, blf.d, brf.d, dir.sDVECTOR, vLen.d
yInc = 1.0 / ScrHeight
xInc = 1.0 / ScrWidth
For ScrY = 0 To ScrHeight
yFac = ScrY * yInc
For ScrX = 0 To ScrWidth
xFac = ScrX * xInc
tlf = (1.0 - yFac) * (1.0 - xFac)
trf = (1.0 - yFac) * xFac
blf = yFac * (1.0 - xFac)
brf = yFac * xFac
dir\x = Camera\Screen\TopLeft\x * tlf + Camera\Screen\TopRight\x * trf + Camera\Screen\BottomLeft\x * blf + Camera\Screen\BottomRight\x * brf
dir\y = Camera\Screen\TopLeft\y * tlf + Camera\Screen\TopRight\y * trf + Camera\Screen\BottomLeft\y * blf + Camera\Screen\BottomRight\y * brf
dir\z = Camera\Screen\TopLeft\z * tlf + Camera\Screen\TopRight\z * trf + Camera\Screen\BottomLeft\z * blf + Camera\Screen\BottomRight\z * brf
vLen = Sqr(dir\x * dir\x + dir\y * dir\y + dir\z * dir\z)
Screen(ScrX, ScrY)\tlf = tlf / vLen
Screen(ScrX, ScrY)\trf = trf / vLen
Screen(ScrX, ScrY)\blf = blf / vLen
Screen(ScrX, ScrY)\brf = brf / vLen
Next
Next
EndProcedure
Procedure UpdateCamera()
Camera\Speed\x + (Camera\Accel * Camera\matRot\m31 + Camera\Strafe * Camera\matRot\m11) * FrameTime
Camera\Speed\y + (Camera\Accel * Camera\matRot\m32 + Camera\Strafe * Camera\matRot\m12) * FrameTime
Camera\Speed\z + (Camera\Accel * Camera\matRot\m33 + Camera\Strafe * Camera\matRot\m13) * FrameTime
Camera\Speed\x - (Camera\Speed\x * 0.2 * FrameTime)
Camera\Speed\y - (Camera\Speed\y * 0.2 * FrameTime)
Camera\Speed\z - (Camera\Speed\z * 0.2 * FrameTime)
Camera\pos\x + Camera\Speed\x * FrameTime
Camera\pos\y + Camera\Speed\y * FrameTime
Camera\pos\z + Camera\Speed\z * FrameTime
MatrixVectorRotation(Camera\Screen\TopLeft, Lens\TopLeft, Camera\matRot)
MatrixVectorRotation(Camera\Screen\TopRight, Lens\TopRight, Camera\matRot)
MatrixVectorRotation(Camera\Screen\BottomLeft, Lens\BottomLeft, Camera\matRot)
MatrixVectorRotation(Camera\Screen\BottomRight, Lens\BottomRight, Camera\matRot)
EndProcedure
Procedure CheckKeys()
Camera\Accel = 0
Camera\Strafe = 0
If Key(#VK_UP) Or Key(#VK_W)
Camera\Accel = 50.0
EndIf
If Key(#VK_DOWN) Or Key(#VK_S)
Camera\Accel = -50.0
EndIf
If Key(#VK_LEFT) Or Key(#VK_A)
Camera\Strafe = -50.0
EndIf
If Key(#VK_RIGHT) Or Key(#VK_D)
Camera\Strafe = 50.0
EndIf
If Key(#VK_SPACE)
Camera\Speed\x = 0
Camera\Speed\y = 0
Camera\Speed\z = 0
MatrixIdentity(Camera\matRot)
Camera\pos\z = -200
EndIf
If Key(#VK_1)
Resolution = 1
EndIf
If Key(#VK_2)
Resolution = 2
EndIf
If Key(#VK_3)
Resolution = 4
EndIf
If Key(#VK_4)
Resolution = 8
EndIf
If Key(#VK_5)
Resolution = 16
EndIf
If Key(#VK_6)
Resolution = 32
EndIf
EndProcedure
Procedure CheckMouse()
Protected rotX.f, rotY.f
rotX = (WindowMouseY(1) - ScrHeight / 2) / (ScrHeight * 2)
MatrixRotateX(Camera\matRot, rotX * FrameTime)
rotY = (WindowMouseX(1) - ScrWidth / 2) / (ScrWidth * 2)
MatrixRotateY(Camera\matRot, rotY * FrameTime)
EndProcedure
Global Aspect.f
Aspect = ScrWidth / ScrHeight
Dim Screen.sSCREEN(ScrWidth, ScrHeight)
ScreenOpen(ScrWidth, ScrHeight, "PureRay")
glMatrixMode_(#GL_PROJECTION)
glLoadIdentity_()
glOrtho(0.0, ScrWidth, ScrHeight, 0.0, -1.0, 1.0)
glMatrixMode_(#GL_MODELVIEW)
glPushMatrix_()
glDisable_(#GL_DEPTH_TEST)
Lens\TopLeft\x = -Aspect
Lens\TopLeft\y = 1.0
Lens\TopLeft\z = 2.0
Lens\TopRight\x = Aspect
Lens\TopRight\y = 1.0
Lens\TopRight\z = 2.0
Lens\BottomLeft\x = -Aspect
Lens\BottomLeft\y = -1.0
Lens\BottomLeft\z = 2.0
Lens\BottomRight\x = Aspect
Lens\BottomRight\y = -1.0
Lens\BottomRight\z = 2.0
AddSphere(-100, 0, 280, 50, AddMaterial(1.0, 0.5, 0.3))
AddSphere(100, 0, 390, 50, AddMaterial(0.1, 0.3, 0.1, 0.8, 0.9, 50))
AddSphere(-100, 200, 600, 100, AddMaterial(0.1, 0.1, 0.2, 0.8, 0.9, 50))
AddSphere(150, -100, 500, 50, AddMaterial(0.2, 1.0, 1.0))
AddSphere(-300, -300, 700, 50, AddMaterial(1.0, 1.0, 0.3))
AddSphere(0, -200, 800, 50, AddMaterial(0.7, 0.3, 1.0))
AddLight(100.0, 100.0, -100.0, 0.7, 0.6, 0.3)
AddLight(-1000.0, 100.0, 300.0, 0.3, 0.4, 0.7)
MatrixIdentity(Camera\matRot)
Camera\pos\z = -200
UpdateCamera()
SetupCamera()
Define.f move = 1.0
Define.l Now
VSyncState(0)
InitGameTimer()
;mainloop
Define.l start,stop
start=ElapsedMilliseconds()
Repeat
Now = timeGetTime_()
Frame + 1
UpdateCamera()
ShootRays(Resolution)
FirstElement(Object())
Object()\Origin\x + move
NextElement(Object())
Object()\Origin\x - move
If Object()\Origin\x <= -100.0 Or Object()\Origin\x >= 100.0
move = -move
EndIf
SwapBuffers_(hdc)
Delay(1)
EventCheckKeys(WindowEvent())
CheckKeys()
CheckMouse()
FrameTime = timeGetTime_() - Now
If FrameTime > 0.1 ; For movement restriction
FrameTime = 0.1 ;
EndIf ;
Until Key(#VK_ESCAPE)
stop=ElapsedMilliseconds()
Frame=Frame/((stop-start)/1000)
MessageRequester("Demo Framespeed",StrU(Frame,#Long)+" fps. (average)")
@Rescator:
Thanks.
But this code isn't optimized at all (except that SetupCamera() trick. Subsampling is a cheat to me, because you loose picture quality)
There are a lot of possibilities for first hit optimization (depth sorting the spheres, precomputing 'c' ( in Trace() ) at start of frame, maybe some kind of screenspace bounding box check...)
For shadow ray testing (always check the last shadowing sphere first)
And I have a lot of other ideas (for example a fake softshadow, that should have almost no speed impact)
And after all I can always convert the critical parts to assembly.
My problem is, if I start to optimize, my code grows like cancer, and gets as ugly and hard to live with.
And I wanted to post that code, before this happens.
like the code is now, it would be easy to turn it into a real raytracer, a real demo, or a small game engine (if we get a little bit more CPU power)
But that ForEach you mentioned is absolutly valid. I always forget about that.
It was just a small sidestep from my main projekt, until I get my new hardware, wich I have now.
I will pick up this again for sure some time, but now it's time for my new GeForce 7800GT.
@THCM: Thanks.
I would love to see a multithreaded version too, but I won't try to do it until I have a multicore CPU, to see the efficiency.
PS: I could easily insert a fps display. I just didn't because I didn't wanted to bloat that code anymore. Even a 'Hello World' by me will have some hundred lines, if I don't force me to stop.
Maybe I've been infected by that MS bloat Virus!?
Thanks.
But this code isn't optimized at all (except that SetupCamera() trick. Subsampling is a cheat to me, because you loose picture quality)
There are a lot of possibilities for first hit optimization (depth sorting the spheres, precomputing 'c' ( in Trace() ) at start of frame, maybe some kind of screenspace bounding box check...)
For shadow ray testing (always check the last shadowing sphere first)
And I have a lot of other ideas (for example a fake softshadow, that should have almost no speed impact)
And after all I can always convert the critical parts to assembly.
My problem is, if I start to optimize, my code grows like cancer, and gets as ugly and hard to live with.
And I wanted to post that code, before this happens.
like the code is now, it would be easy to turn it into a real raytracer, a real demo, or a small game engine (if we get a little bit more CPU power)
But that ForEach you mentioned is absolutly valid. I always forget about that.
It was just a small sidestep from my main projekt, until I get my new hardware, wich I have now.
I will pick up this again for sure some time, but now it's time for my new GeForce 7800GT.
@THCM: Thanks.
I would love to see a multithreaded version too, but I won't try to do it until I have a multicore CPU, to see the efficiency.
PS: I could easily insert a fps display. I just didn't because I didn't wanted to bloat that code anymore. Even a 'Hello World' by me will have some hundred lines, if I don't force me to stop.
Maybe I've been infected by that MS bloat Virus!?
-
SoulReaper
- Enthusiast

- Posts: 372
- Joined: Sun Apr 03, 2005 2:14 am
- Location: England
