PureRay - Realtime Raytracing Demo

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

PureRay - Realtime Raytracing Demo

Post by Hades »

Hi folks,

last weekend I fried my graphics card. As you surely know, it's impossible to live without nice and fast 3d graphics, so I had to do something. :D

I remembered This thread by Dreglor, and wanted to create an interactive raytracing demo.

So here it is:

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
;
;-------------------------------------------------------------------------------------------------------------------------

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
  ResetList(Object())
  While NextElement(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  
  Wend
  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 
    
    ResetList(Light())
    While NextElement(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
      ResetList(Object())
      While NextElement(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
      Wend
      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
    Wend
    
    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()

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)

Ok, it's spheres only and without comments, but it's hacked together in less than two days. :roll:


If you don't see anything, you've probably moved the mouse at the start of the program and turned away from the Scene. Just press [Space] to reset the camera.
Top
DarkDragon
Addict
Addict
Posts: 2347
Joined: Mon Jun 02, 2003 9:16 am
Location: Germany
Contact:
Contact DarkDragon

Post by DarkDragon »

Realtime? You don't understand what realtime means, huh?
bye,
Daniel
Top
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

Hmpf.

What's you're CPU?

Debugger On???
Top
Fred
Administrator
Administrator
Posts: 18351
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:
Contact Fred

Post by Fred »

Looks very nice, impressive.
Top
DarkDragon
Addict
Addict
Posts: 2347
Joined: Mon Jun 02, 2003 9:16 am
Location: Germany
Contact:
Contact DarkDragon

Post by DarkDragon »

GFX-Card: VIA S3 Unichrome IGP 32 MB Shared Memory(VSync not able to turn off)
CPU: AMD Athlon XP-M 2200+ 512 MB RAM

tried with Debugger On and Off
Last edited by DarkDragon on Wed Mar 08, 2006 7:01 pm, edited 1 time in total.
bye,
Daniel
Top
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

@ Fred: Thank you, now I'm happy again. :D
Top
traumatic
PureBasic Expert
PureBasic Expert
Posts: 1661
Joined: Sun Apr 27, 2003 4:41 pm
Location: Germany
Contact:
Contact traumatic

Re: PureRay - Realtime Raytracing Demo

Post by traumatic »

Now this is definitively cool, thanks for sharing!

(Runs astoundingly smooth here, I must admit I'm deeply impressed,
which is something I don't like to be ;))
Good programmers don't comment their code. It was hard to write, should be hard to read.
Top
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

:D

@ DarkDragon:
Just tested it again on my old Athlon 1500, and it's ok (for me). But on older graphics card you could get artifacts due to bad OpenGL support. ( not that flickering, really bad artifacts)

Maybe you thought you get 60 fps with raytracing in PureBasic ?
Top
DarkDragon
Addict
Addict
Posts: 2347
Joined: Mon Jun 02, 2003 9:16 am
Location: Germany
Contact:
Contact DarkDragon

Post by DarkDragon »

Hades wrote::D

@ DarkDragon:
Just tested it again on my old Athlon 1500, and it's ok (for me). But on older graphics card you could get artifacts due to bad OpenGL support. ( not that flickering, really bad artifacts)

Maybe you thought you get 60 fps with raytracing in PureBasic ?
It's less than -0.5 FPS. With adaptive subsampling you'll get about 60 FPS. And it's a new gfx card but notebook ;) .
bye,
Daniel
Top
User avatar
Joakim Christiansen
Addict
Addict
Posts: 2452
Joined: Wed Dec 22, 2004 4:12 pm
Location: Norway
Contact:
Contact Joakim Christiansen

Post by Joakim Christiansen »

Damn, got like... 2 fps here... but it looks nice!
Last edited by Joakim Christiansen on Wed Mar 08, 2006 7:26 pm, edited 2 times in total.
Top
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

Thanks. :D

What's your CPU?
Top
DarkDragon
Addict
Addict
Posts: 2347
Joined: Mon Jun 02, 2003 9:16 am
Location: Germany
Contact:
Contact DarkDragon

Post by DarkDragon »

The theory of Adaptive Subsampling is very simple: Raytrace every 4th or 5th(build it dynamic) pixel and interpolate between found ones.
bye,
Daniel
Top
User avatar
Joakim Christiansen
Addict
Addict
Posts: 2452
Joined: Wed Dec 22, 2004 4:12 pm
Location: Norway
Contact:
Contact Joakim Christiansen

Post by Joakim Christiansen »

Just turned of the debugger now :oops:
And got much more fps, nice!
Top
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

2 fps with debugger on? Not bad. :lol:

@DarkDragon: I know, It's in that code. Try numbers 1-5 :wink:
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

not bad !

from french forum, another good one : http://purebasic.hmt-forum.com/viewtopic.php?t=4615
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
Post Reply

Return to “General Discussion”