PureRay - Realtime Raytracing Demo

Everything else that doesn't fall into one of the other PB categories.
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

Wow. :D

But my french is only good enough to get slapped for. :roll:
DarkDragon
Addict
Addict
Posts: 2347
Joined: Mon Jun 02, 2003 9:16 am
Location: Germany
Contact:

Post by DarkDragon »

Hmm if the screen is active, I'll get very very very less FPS, if it's not I get very very high fps and it's rendered over all other windows.
bye,
Daniel
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

Sorry, but I can't replicate that. Any idea?
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Wow - nice effect.

Thanks for sharing this.

cheers
dracflamloc
Addict
Addict
Posts: 1648
Joined: Mon Sep 20, 2004 3:52 pm
Contact:

Post by dracflamloc »

Neat
Dreglor
Enthusiast
Enthusiast
Posts: 759
Joined: Sat Aug 02, 2003 11:22 pm
Location: OR, USA

Post by Dreglor »

Nice, but i have to ask what what are you doing to speed it up some sort of subsampling? becasue i see alot of artifacts when when the "resolution" is 32

Oh and be prepared to for what is comming soon...
~Dreglor
User avatar
blueznl
PureBasic Expert
PureBasic Expert
Posts: 6172
Joined: Sat May 17, 2003 11:31 am
Contact:

Post by blueznl »

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... )
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

Yes, those artifacts are caused by the subsampling. I check only every nth Pixel and refine if a certain color difference is exceeded. Obviously there is the chance to miss detail. :(

Dreglor, nice to hear from you and your raytracer? again. :D
Dreglor
Enthusiast
Enthusiast
Posts: 759
Joined: Sat Aug 02, 2003 11:22 pm
Location: OR, USA

Post by Dreglor »

ah so your using a much simpiler version of my subsampling
~Dreglor
benny
Enthusiast
Enthusiast
Posts: 465
Joined: Fri Apr 25, 2003 7:44 pm
Location: end of www
Contact:

Post by benny »

very impressing :!: :!: :!:
regards,
benny!
-
pe0ple ar3 str4nge!!!
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

Thanks. :D

@Dreglor: Yes, the simplest possible. There's not much to gain from a more complex one, if there are just 6 Spheres on the screen.

How long do we have to wait for your new Version? I'm curious about it.
User avatar
Rescator
Addict
Addict
Posts: 1769
Joined: Sat Feb 19, 2005 5:05 pm
Location: Norway

Post by Rescator »

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 :P

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)")

THCM
Enthusiast
Enthusiast
Posts: 276
Joined: Fri Apr 25, 2003 5:06 pm
Location: Gummersbach - Germany
Contact:

Post by THCM »

Nice work! I get about 25fps here. Would be nice to see a multithreaded version...
The Human Code Machine / Masters' Design Group
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

@Rescator:

Thanks. :D

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. :D
And I wanted to post that code, before this happens. :wink:

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. :oops:

It was just a small sidestep from my main projekt, until I get my new hardware, wich I have now. :D

I will pick up this again for sure some time, but now it's time for my new GeForce 7800GT. :D


@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
Enthusiast
Posts: 372
Joined: Sun Apr 03, 2005 2:14 am
Location: England

Post by SoulReaper »

Very nice indeed :shock: :D

Regards
Kevin :wink:
Post Reply