Real Time Ray Tracing

User projects written in or related to FreeBASIC.
Post Reply
Voltage
Posts: 110
Joined: Nov 19, 2005 7:36
Location: Sydney, Australia
Contact:
Contact Voltage

Real Time Ray Tracing

Post by Voltage »

Howdy all,

I haven't posted here in a while, but I thought some of you might find this interesting.

Real time raytracing (in progress)...

- Spheres only at this stage
- Shadows
- 1 level of reflection
- Diffuse, and specular lighting

It uses a funky optimisation called sub sampling to acheive (near) real time.

I'm getting 14.5 FPS on this PC.

What about you?

Code: Select all

'Realtime Ray Tracer v0.2
'by Voltage 
'Started 21/3/2007
'Last update 2/5/2007
'Compiles with FreeBasic v0.16 (Tested on Win 32)

'DONE! - Cast a ray through each screen coord
'DONE! - Check for intersection with triangle
'DONE! - Find closest object that intersected
'DONE! - Draw appropriate diffuse colour
'DONE! - Basic Shadows (hard edges)
'DONE! - Spheres
'DONE! - Specular lighting
'DONE! - Improve the sub sampler
'DONE! - Interpolate between sub sample corners, instead of the quick and dirty rectangle in colour 0
'DONE! - Quicker sphere intersection test (2d bounding circle check)
'DONE! - Reflection
'DONE! - Clean up code for recursion and optimisation
'DONE! - Fix sub sample metric code to check if corners are all in or all out of shadow / ugly shadow bug

'*** STILL TO DO ***
'Adaptive subsampling - Instead of crappy 6x6 non adaptive
'Optimise for multiple processors
'Recursive reflections
'Texture maps
'Add Plane object
'Add Cylinder object
'Add CSG

Option Explicit

#define Vec_DotProduct(v1,v2) (v1.x*v2.x + v1.y*v2.y + v1.z*v2.z)

Type VectorType
  x As Single
  y As Single
  z As Single
End Type

Type RayType
  origin As VectorType
  dir As VectorType
  ShadowRay As Integer
  CurrentObject As Integer
  CurrentObjectType As Integer
  ScreenX As Integer
  ScreenY As Integer
End Type

Type IntersectionType
  Dist As Single
  Object As Integer
  ObjectType As Integer
  u As Single
  v As Single
End Type

Type TriangleType
  v1 As VectorType 
  v2 As VectorType
  v3 As VectorType
  Plane As RayType
  R As UByte
  G As UByte
  B As UByte
End Type

Type SphereType
  Centre As VectorType
  Radius As Single
  R As UByte
  G As UByte
  B As UByte
  cx As Integer
  cy As Integer
  ProjectedRadiusSquared As Integer
End Type

Type SubSampleType
  Colour As Integer
  Object As Integer
  Shadowed As Integer
End Type

Type RGBType
  r As Integer
  g As Integer
  b As Integer
End Type

Type ColourCalc
  Colour As RGBType
  Shadowed As Integer
  IP As VectorType 
  N As VectorType
End Type

Declare Function Vec_Normalize(v As VectorType) As VectorType
Declare Function FindClosestIntersection(Ray As RayType) As InterSectionType
Declare Function SphereIntersect(R As RayType, S As SphereType) As IntersectionType
Declare Function Vec_Subtract(v1 As VectorType, v2 As VectorType) As VectorType
Declare Sub SetupScene
Declare Function CalculateColour(Object As Integer, ObjectType As Integer, R As RayType, L As Single) As ColourCalc
Declare Function CornersAreSame As Integer
Declare Sub InterpolateSquare(sx,sy,sqSize As Single)
Declare Function InShadow(ShadowRay As RayType) As InterSectionType
Declare Function ReflectRay(V As RayType, IP As VectorType, N As VectorType) As RayType
Declare Function GetRayColour(MyRay As RayType) As SubSampleType

Const SCR_W=320
Const SCR_H=200
Const ViewDistance = 300
Const NUMSPHERES = 9 'The first sphere is the light source
Const EPSILON=0.000001
Const TRUE = -1
Const FALSE = 0
Const SP=2
Const SampleSize = 6
Const SPH = 2

Dim As RayType MyRay, MyReflectedRay 
Dim As IntersectionType MyIntersection,MyIntersection2
Dim As ColourCalc Colour, Colour2
Dim Shared Spheres(1 To NUMSPHERES) As SphereType
Dim As Integer x,y,a,x1,y1,SubSampleCount,x2,y2
Dim Shared As VectorType LightSource
Dim Shared Corners(0 To 3) As SubSampleType
Dim Shared SubSamples(Int(SCR_W/SampleSize)+1,Int(SCR_H/SampleSize)+1) As SubSampleType
Dim BounceSphere As Single
Dim As Integer s,s1,Ticks
Dim Shared LastShadowCaster As Integer
Dim As Single StartTime,FPS
Dim Shared As Integer ErrorCutOff
Dim key$
Dim RayColour As SubSampleType

'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************                                                ************************************
'**************************                   MAIN CODE                    ************************************
'**************************                                                ************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************

Screen 15,32,2
s=0:s1=1
ScreenSet s,s1

'Randomize Timer
Randomize -8


'Light Source
LightSource.x = 300
LightSource.y = -100
LightSource.z = -200
 
'View point
MyRay.origin.x=SCR_W/2
MyRay.origin.y=SCR_H/2 - 10
MyRay.origin.z=-ViewDistance
MyRay.ShadowRay = FALSE ' This ray is not checking InShadow
MyRay.CurrentObject=-1

SetupScene

ErrorCutOff = 40

StartTime=Timer
Do
  BounceSphere=BounceSphere+.2
  For a=1 To NUMSPHERES
    If a<>1 Then Spheres(a).Centre.Y=140-Abs(Sin(BounceSphere+a)*90+a)
    Spheres(a).cx=SCR_W/2+((Spheres(a).Centre.x-MyRay.Origin.x)*ViewDistance)/(Spheres(a).Centre.z+ViewDistance)
    Spheres(a).cy=SCR_H/2-10+((Spheres(a).Centre.y-MyRay.Origin.y)*ViewDistance)/(Spheres(a).Centre.z+ViewDistance)
    Spheres(a).ProjectedRadiusSquared=((Spheres(a).Radius)*ViewDistance*1.15)/(Spheres(a).Centre.z+ViewDistance)
    Spheres(a).ProjectedRadiusSquared=Spheres(a).ProjectedRadiusSquared*Spheres(a).ProjectedRadiusSquared
  Next a

  '**********************************************************************
  '**********************************************************************
  '**********************************************************************
  '*******************************  RENDER  *****************************
  '**********************************************************************
  '**********************************************************************
  '**********************************************************************
  SubSampleCount=0
  x1=0
  y1=0
  For y=0 To SCR_H Step SampleSize
    For x=0 To SCR_W Step SampleSize
      MyRay.dir.x = x - MyRay.origin.x
      MyRay.dir.y = y - MyRay.origin.y
      MyRay.dir.z = - MyRay.origin.z
      MyRay.dir = Vec_Normalize(MyRay.Dir)
      MyRay.ScreenX = x
      MyRay.ScreenY = y
      MyRay.CurrentObject=0
      SubSamples(x1,y1) = GetRayColour(MyRay)
      PSet(x,y),SubSamples(x1,y1).Colour
      x1+=1
    Next x
    y1+=1
    x1=0
  Next y

  x1=0
  y1=0
  For y=0 To SCR_H Step SampleSize
    For x=0 To SCR_W Step SampleSize
      Corners(0)=SubSamples(x1,y1)
      Corners(1)=SubSamples(x1+1,y1)
      Corners(2)=SubSamples(x1,y1+1)
      Corners(3)=SubSamples(x1+1,y1+1)
      If CornersAreSame Then
        SubSampleCount+=(SampleSize*SampleSize)-4
        InterpolateSquare x,y,SampleSize
      Else
        MyRay.CurrentObject=0
        For y2=0 To SampleSize-1
          For x2=0 To SampleSize-1
            'Setup Ray for each screen pixel
            MyRay.dir.x = (x+x2) - MyRay.origin.x
            MyRay.dir.y = (y+y2) - MyRay.origin.y
            MyRay.dir.z = - MyRay.origin.z
            MyRay.dir = Vec_Normalize(MyRay.Dir)
            MyRay.ScreenX = x+x2
            MyRay.ScreenY = y+y2
            RayColour = GetRayColour(MyRay)
            PSet (x2+x,y2+y),RayColour.Colour
          Next x2
        Next y2
      End If
      x1+=1
    Next x
    y1+=1
    x1=0
  Next y
  Ticks+=1
  FPS = Ticks/(Timer-StartTime)
  
  key$=InKey$
  If key$=Chr$(27) Then Exit Do
  
  Color rgb(68,128,255)
  Locate 28,1:? " Sub sample results"
  Color rgb(255,255,255)
  Print SCR_W*SCR_H;" -";SubSampleCount;" =";SCR_W*SCR_H-SubSampleCount
  Color rgb(128,128,255)
  Print " Total Skipped   Calculated Rays"
  Color rgb(212,212,255)
  Locate 32,1:? " FPS:";FPS
  Color rgb(255,212,212)
  Locate 34,1:? " Image quality:";ErrorCutOff;"   "
  Color rgb(Rnd(1)*155+100,Rnd(1)*155+100,Rnd(1)*155+100)
  Print " Press 1-5 to change quality"
  Select Case key$
    Case Is = "1"
      ErrorCutOff = 0
    Case Is = "2"
      ErrorCutOff = 15
    Case Is = "3"
      ErrorCutOff = 40
    Case Is = "4"
      ErrorCutOff = 65
    Case Is = "5"
      ErrorCutOff = 130
  End Select

  Swap s,s1
  ScreenSet s,s1
Loop



'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************                                                ************************************
'**************************            FUNCTIONS AND SUBS                  ************************************
'**************************                                                ************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************

Function Vec_Normalize(v As VectorType) As VectorType
  Dim l As Single
  
  l=1.0/Sqr(v.x*v.x+v.y*v.y+v.z*v.z)

  v.x=v.x*l
  v.y=v.y*l
  v.z=v.z*l

  Vec_Normalize = v
End Function

Function FindClosestIntersection(Ray As RayType) As InterSectionType
  Dim Result As InterSectionType
  Dim As Integer a,xd,yd
  Dim Intersect As InterSectionType

  'Set the default return values
  Result.Dist=-1
  Result.Object=-1

  If Ray.CurrentObject=0 Then
    For a=1 To NUMSPHERES
      'Optimization  - Check if squared distance from this ray to centre of sphere is >radius
      xd = Spheres(a).cx - Ray.ScreenX
      yd = Spheres(a).cy - Ray.ScreenY
      If (xd*xd+yd*yd) > Spheres(a).ProjectedRadiusSquared Then
        Intersect.Dist = -1
      Else
        Intersect = SphereIntersect(Ray, Spheres(a))
        If Intersect.Dist>0 Then 
          If Result.Dist<>-1 Then
            If Intersect.Dist < Result.Dist Then
              Result.Dist = Intersect.Dist
              Result.Object = a
              Result.ObjectType = SPH
              Result.u = Intersect.u
              Result.v = Intersect.v
            End If
          Else
            Result.Dist = Intersect.Dist
            Result.Object = a
            Result.ObjectType = SPH
            Result.u = Intersect.u
            Result.v = Intersect.v
          End If
        End If
      End If
    Next a
  Else
    For a=1 To NUMSPHERES
      If a=Ray.CurrentObject Then
        Intersect.Dist=-1
      Else
        Intersect = SphereIntersect(Ray, Spheres(a))
        If Intersect.Dist>0 Then 
          If Result.Dist<>-1 Then
            If Intersect.Dist < Result.Dist Then
              Result.Dist = Intersect.Dist
              Result.Object = a
              Result.ObjectType = SPH
              Result.u = Intersect.u
              Result.v = Intersect.v
            End If
          Else
            Result.Dist = Intersect.Dist
            Result.Object = a
            Result.ObjectType = SPH
            Result.u = Intersect.u
            Result.v = Intersect.v
          End If
        End If
      End If
    Next a
  End If
  FindClosestIntersection = Result
End Function

Function InShadow(ShadowRay As RayType) As InterSectionType
  Dim Intersect As IntersectionType
  Dim As Integer a,a1

  Intersect.Dist = -1
  If LastShadowCaster=0 Then
    a1=2: 'Object 1 is the light source
  Else
    a1=LastShadowCaster
  End If
  For a=2 To NUMSPHERES
    'The next check is so we don't check for intersections with the intersect point object
    If a1<>ShadowRay.CurrentObject Then
      Intersect = SphereIntersect(ShadowRay, Spheres(a1))
      If Intersect.Dist>0 Then 
        Intersect.Dist = 1
        InShadow = Intersect
        Exit Function
      End If
    End If
    a1=a1+1:If a1>NUMSPHERES Then a1=2: 'Object 1 is the light source
  Next a
  InShadow = Intersect
End Function

Function SphereIntersect(R As RayType, S As SphereType) As IntersectionType
  Dim Result as IntersectionType
  Dim As VectorType rayToSphereCentre
  Dim As Single SquaredDistToCentre, ClosestApproach, HalfCord2
  
  rayToSphereCentre.x = S.Centre.x-R.Origin.x
  rayToSphereCentre.y = S.Centre.y-R.Origin.y
  rayToSphereCentre.z = S.Centre.z-R.Origin.z
  SquaredDistToCentre = Vec_DotProduct(rayToSphereCentre, rayToSphereCentre)

  ClosestApproach = Vec_DotProduct(rayToSphereCentre, R.Dir)
  If ClosestApproach<0 Then
    Result.Dist=-1
    SphereIntersect = Result
    Exit Function
  End If

  HalfCord2 = (S.Radius * S.Radius) - SquaredDistToCentre + (ClosestApproach * ClosestApproach)

  If HalfCord2 < 0 Then
    Result.Dist=-1
    SphereIntersect = Result
    Exit Function
  End If
    
  Result.Dist = ClosestApproach - Sqr(Halfcord2)
  SphereIntersect = Result
End Function

Function Vec_Subtract(v1 As VectorType, v2 As VectorType) As VectorType
  Dim Result As VectorType
  
  Result.x = v1.x - v2.x
  Result.y = v1.y - v2.y
  Result.z = v1.z - v2.z

  Vec_Subtract = Result
End Function

Sub SetupScene
  Dim a As Integer

  'Now the spheres
  If NUMSPHERES>0 Then
    For a=1 To NUMSPHERES
      Spheres(a).Centre.x = Int(Rnd(1)*(SCR_W-100))+50
      Spheres(a).Centre.y = Int(Rnd(1)*SCR_H/2)+SCR_H/2
      Spheres(a).Centre.z = Int(Rnd(1)*SCR_H)-SCR_H/2
      Spheres(a).Radius = 35
      Spheres(a).r=Int(Rnd(1)*200)+55
      Spheres(a).g=Int(Rnd(1)*200)+55
      Spheres(a).b=Int(Rnd(1)*200)+55
    Next a
  End If

  'Make sphere 1 the light source
  Spheres(1).Centre = LightSource
  Spheres(1).Radius = 25

  Spheres(1).r=255
  Spheres(1).g=255
  Spheres(1).b=255
End Sub

Function CalculateColour(Object As Integer, ObjectType As Integer, Ray As RayType, L As Single) As ColourCalc
  Dim As Single DP,SpecRDT,Spec,Shade,SpecDOT
  Dim As VectorType IL,SpecR,SpecV
  Dim As IntersectionType AnIntersection
  Dim As RayType ARay
  Dim As Integer R,G,B
  Dim Result As ColourCalc
  
  'Get the intersection point
  Result.IP.x=Ray.Origin.x + Ray.Dir.x * L
  Result.IP.y=Ray.Origin.y + Ray.Dir.y * L
  Result.IP.z=Ray.Origin.z + Ray.Dir.z * L

  'Create a vector from the intersection point to the light source
  IL = Vec_Normalize(Vec_Subtract(LightSource,Result.IP))
  
  'Get the dot product of the normal and this new vector
  Result.N = Vec_Normalize(Vec_Subtract(Result.IP,Spheres(Object).Centre))

  DP = (Vec_DotProduct(IL, Result.N))+.2
  If DP>0 Then
    'Check if intersection point is in the shadow of another object
    ARay.Origin = Result.IP
    ARay.Dir = IL
    ARay.CurrentObject = Object
    ARay.CurrentObjectType = ObjectType
    AnIntersection = InShadow(ARay)
    
    'In shadow?
    Result.Shadowed=1
    If AnIntersection.Dist>0 Then
      'Use these results to calc the light value
      DP=DP*.25
      Result.Shadowed = 0
    End If

    'Calculate Specular
    Spec=0
    SpecV.x = 0
    SpecV.y = 0
    SpecV.z = Sgn(ViewDistance)
    SpecRDT = 2 * Vec_DotProduct( IL, Result.N )
    SpecR.x = IL.x - SpecRDT * Result.N.x
    SpecR.y = IL.y - SpecRDT * Result.N.y
    SpecR.z = IL.z - SpecRDT * Result.N.z
    SpecDOT = Vec_DotProduct(SpecV, SpecR)
    If SpecDOT > 0.0 Then
      Spec = SpecDOT ^ 20 * 0.55 * Result.Shadowed * 255
    End If 

    r=Spheres(Object).r * dp + spec
    g=Spheres(Object).g * dp + spec
    b=Spheres(Object).b * dp + spec

    If r>255 Then r = 255
    If g>255 Then g = 255
    If b>255 Then b = 255

    Result.Colour.r = r
    Result.Colour.g = g
    Result.Colour.b = b
  Else
    Result.Colour.r = 0
    Result.Colour.g = 0
    Result.Colour.b = 0
  End If
  CalculateColour = Result
End Function

Function CornersAreSame As Integer
  Dim As UByte r,g,b,r1,g1,b1,a 
  
  If Corners(0).Object=Corners(1).Object Then
    If Corners(0).Object=Corners(2).Object Then
      If Corners(0).Object=Corners(3).Object Then
        If Corners(0).Shadowed<>Corners(1).Shadowed Or Corners(0).Shadowed<>Corners(2).Shadowed Or Corners(0).Shadowed<>Corners(3).Shadowed Then
          CornersAreSame=FALSE
          Exit Function
        End If

        r=(Corners(0).Colour Shr 16) And 255
        g=(Corners(0).Colour Shr 8) And 255
        b=Corners(0).Colour And 255
      
        For a=1 To 3 
          r1=(Corners(a).Colour Shr 16) And 255
          g1=(Corners(a).Colour Shr 8) And 255
          b1=Corners(a).Colour And 255
          If Abs(r1-r)>ErrorCutoff Then
            CornersAreSame=FALSE
            Exit Function
          End If
          If Abs(g1-g)>ErrorCutoff Then
            CornersAreSame=FALSE
            Exit Function
          End If
          If Abs(b1-b)>ErrorCutoff Then
            CornersAreSame=FALSE
            Exit Function
          End If
        Next a
        CornersAreSame=TRUE
        Exit Function
      Else 
        CornersAreSame=FALSE
        Exit Function
      End If
    Else
      CornersAreSame=FALSE
      Exit Function
    End If
  Else
    CornersAreSame=FALSE
    Exit Function
  End If
End Function

Sub InterpolateSquare(sx,sy,sqSize As Single)
  Dim c1 As RGBType
  Dim As Single rs,gs,bs
  Dim c(3) As RGBType
  Dim As Integer ca,cb,car,cab,cag,cbr,cbg,cbb,x,y
  
  For x=0 To 3
    c(x).r = (Corners(x).Colour Shr 16) And 255
    c(x).g = (Corners(x).Colour Shr 8) And 255
    c(x).b = Corners(x).Colour And 255
  Next x
  
  y=0
  rs=(c(1).r-c(0).r)/sqSize
  gs=(c(1).g-c(0).g)/sqSize
  bs=(c(1).b-c(0).b)/sqSize
  For x=0 To sqSize
    c1.r=c(0).r+x*rs
    c1.g=c(0).g+x*gs
    c1.b=c(0).b+x*bs
    PSet (x+sx,y+sy),RGB(c1.r,c1.g,c1.b) 
  Next x
  
  y=sqSize
  rs=(c(3).r-c(2).r)/sqSize
  gs=(c(3).g-c(2).g)/sqSize
  bs=(c(3).b-c(2).b)/sqSize
  For x=0 To sqSize
    c1.r=c(2).r+x*rs
    c1.g=c(2).g+x*gs
    c1.b=c(2).b+x*bs
    PSet (x+sx,y+sy),RGB(c1.r,c1.g,c1.b) 
  Next x
  
  For x=0 To sqSize
    ca=Point(x+sx,sy)
    cb=Point(x+sx,sqSize+sy)
    car=(ca Shr 16) And 255
    cag=(ca Shr 8) And 255
    cab=ca And 255
    cbr=(cb Shr 16) And 255
    cbg=(cb Shr 8) And 255
    cbb=cb And 255
    rs=(cbr-car)/sqSize
    gs=(cbg-cag)/sqSize
    bs=(cbb-cab)/sqSize
    For y=1 To sqSize-1
      c1.r=car+y*rs
      c1.g=cag+y*gs
      c1.b=cab+y*bs
      PSet (x+sx,y+sy),RGB(c1.r,c1.g,c1.b) 
    Next y
  Next x
End Sub

Function ReflectRay(V As RayType, IP As VectorType, N As VectorType) As RayType
  Dim Result As RayType
  Dim Dot As Single
  
  Result.Origin = IP
  Dot = 2 * Vec_DotProduct(V.Dir, N)
  Result.Dir.x = V.Dir.x - Dot * N.x
  Result.Dir.y = V.Dir.y - Dot * N.y
  Result.Dir.z = V.Dir.z - Dot * N.z
  Result.Dir = Vec_Normalize(Result.Dir)

  ReflectRay = Result
End Function

Function GetRayColour(MyRay As RayType) As SubSampleType
  Dim As RayType MyReflectedRay 
  Dim As IntersectionType MyIntersection,MyIntersection2
  Dim As ColourCalc Colour, Colour2
  Dim Result As SubSampleType

  MyIntersection = FindClosestIntersection(MyRay)
  If MyIntersection.Dist>0 Then
    Colour = CalculateColour(MyIntersection.Object,MyIntersection.ObjectType,MyRay,MyIntersection.Dist)
    MyReflectedRay = ReflectRay(MyRay, Colour.IP, Colour.N)
    MyReflectedRay.CurrentObject = MyIntersection.Object
    MyIntersection2 = FindClosestIntersection(MyReflectedRay)
    If MyIntersection2.Dist>0 Then
      Colour2 = CalculateColour(MyIntersection2.Object,MyIntersection2.ObjectType,MyReflectedRay,MyIntersection2.Dist)
      Colour.Colour.r = Colour.Colour.r + Colour2.Colour.r/2:If Colour.Colour.r>255 Then Colour.Colour.r=255
      Colour.Colour.g = Colour.Colour.g + Colour2.Colour.g/2:If Colour.Colour.g>255 Then Colour.Colour.g=255
      Colour.Colour.b = Colour.Colour.b + Colour2.Colour.b/2:If Colour.Colour.b>255 Then Colour.Colour.b=255
    Else
      Colour.Colour.r = Colour.Colour.r+10:If Colour.Colour.r>255 Then Colour.Colour.r=255
      Colour.Colour.g = Colour.Colour.g+10:If Colour.Colour.g>255 Then Colour.Colour.g=255
      Colour.Colour.b = Colour.Colour.b+10:If Colour.Colour.b>255 Then Colour.Colour.b=255
    End If
    Result.Colour = RGB(Colour.Colour.r,Colour.Colour.g,Colour.Colour.b)
    Result.Shadowed = Colour.Shadowed
    Result.Object = MyIntersection.Object
  Else
    Result.Colour = RGB(20,20,20)
    Result.Shadowed = FALSE
    Result.Object = -1
  End If
  GetRayColour = Result
End Function
Top
axipher
Posts: 891
Joined: Dec 27, 2005 16:37
Location: Sudbury,Ontario

Post by axipher »

Not bad, looks very good. One thing though, I noticed that quality of 1 is blocky and 5 is seemingly anti-aliased, and I get 9 FPS in all modes, yet 5 is much faster and smoother, very odd, and your FPS counter isn;t set-up properly.
Top
DrV
Site Admin
Posts: 2116
Joined: May 27, 2005 18:39
Location: Midwestern USA
Contact:
Contact DrV

Post by DrV »

Looks nice. :) On the default quality, it gets about 19 FPS; on quality 5, it gets about 23.6 FPS. (Athlon 64 X2 4200+, 2 GB 400 MHz DDR)
Top
nobozoz
Posts: 238
Joined: Nov 17, 2005 6:24
Location: Chino Hills, CA, USA

Post by nobozoz »

Hi,

Interesting.
BTW, I compiled your code in v0.17b (recent build) and ran it on a Celeron 1.5 MHz with a shared memory video (nVidia GeForce2 Go).

I also monkeyed a bit with the FPS counter to get a more stable average reading (30 trips through the loop).

4.8, 5.0, 6.8, 7.6 and 8.6 FPS for quality 1~5 respectively.

Jim
Top
D.J.Peters
Posts: 8631
Joined: May 28, 2005 3:28
Contact:
Contact D.J.Peters

Post by D.J.Peters »

nice on AMD 2200 with 1.8 GHz. ~13-15 FPS
Top
Mlok
Posts: 123
Joined: Mar 08, 2006 1:07
Location: Czech Republic
Contact:
Contact Mlok

Post by Mlok »

Looks very nice.
I get 14 FPS on quality 5, but the number is constantly slowly growing, for some mysterious reason :) You have a bug there..
cca 11 FPs on quality 0
Sempron 2600+
Top
ikkejw
Posts: 258
Joined: Jan 15, 2006 15:51
Location: Fryslân, the Netherlands
Contact:
Contact ikkejw

Post by ikkejw »

I fixed your FPS counter, don't know if it worked but it didn't seem too reliable ;)

Code: Select all

'Realtime Ray Tracer v0.2
'by Voltage
'Started 21/3/2007
'Last update 2/5/2007
'Compiles with FreeBasic v0.16 (Tested on Win 32)

'DONE! - Cast a ray through each screen coord
'DONE! - Check for intersection with triangle
'DONE! - Find closest object that intersected
'DONE! - Draw appropriate diffuse colour
'DONE! - Basic Shadows (hard edges)
'DONE! - Spheres
'DONE! - Specular lighting
'DONE! - Improve the sub sampler
'DONE! - Interpolate between sub sample corners, instead of the quick and dirty rectangle in colour 0
'DONE! - Quicker sphere intersection test (2d bounding circle check)
'DONE! - Reflection
'DONE! - Clean up code for recursion and optimisation
'DONE! - Fix sub sample metric code to check if corners are all in or all out of shadow / ugly shadow bug

'*** STILL TO DO ***
'Adaptive subsampling - Instead of crappy 6x6 non adaptive
'Optimise for multiple processors
'Recursive reflections
'Texture maps
'Add Plane object
'Add Cylinder object
'Add CSG

Option Explicit

#define Vec_DotProduct(v1,v2) (v1.x*v2.x + v1.y*v2.y + v1.z*v2.z)

Type VectorType
  x As Single
  y As Single
  z As Single
End Type

Type RayType
  origin As VectorType
  dir As VectorType
  ShadowRay As Integer
  CurrentObject As Integer
  CurrentObjectType As Integer
  ScreenX As Integer
  ScreenY As Integer
End Type

Type IntersectionType
  Dist As Single
  Object As Integer
  ObjectType As Integer
  u As Single
  v As Single
End Type

Type TriangleType
  v1 As VectorType
  v2 As VectorType
  v3 As VectorType
  Plane As RayType
  R As Ubyte
  G As Ubyte
  B As Ubyte
End Type

Type SphereType
  Centre As VectorType
  Radius As Single
  R As Ubyte
  G As Ubyte
  B As Ubyte
  cx As Integer
  cy As Integer
  ProjectedRadiusSquared As Integer
End Type

Type SubSampleType
  Colour As Integer
  Object As Integer
  Shadowed As Integer
End Type

Type RGBType
  r As Integer
  g As Integer
  b As Integer
End Type

Type ColourCalc
  Colour As RGBType
  Shadowed As Integer
  IP As VectorType
  N As VectorType
End Type

Declare Function Vec_Normalize(v As VectorType) As VectorType
Declare Function FindClosestIntersection(Ray As RayType) As InterSectionType
Declare Function SphereIntersect(R As RayType, S As SphereType) As IntersectionType
Declare Function Vec_Subtract(v1 As VectorType, v2 As VectorType) As VectorType
Declare Sub SetupScene
Declare Function CalculateColour(Object As Integer, ObjectType As Integer, R As RayType, L As Single) As ColourCalc
Declare Function CornersAreSame As Integer
Declare Sub InterpolateSquare(sx,sy,sqSize As Single)
Declare Function InShadow(ShadowRay As RayType) As InterSectionType
Declare Function ReflectRay(V As RayType, IP As VectorType, N As VectorType) As RayType
Declare Function GetRayColour(MyRay As RayType) As SubSampleType

Const SCR_W=320
Const SCR_H=200
Const ViewDistance = 300
Const NUMSPHERES = 9 'The first sphere is the light source
Const EPSILON=0.000001
Const TRUE = -1
Const FALSE = 0
Const SP=2
Const SampleSize = 6
Const SPH = 2

Dim As RayType MyRay, MyReflectedRay
Dim As IntersectionType MyIntersection,MyIntersection2
Dim As ColourCalc Colour, Colour2
Dim Shared Spheres(1 To NUMSPHERES) As SphereType
Dim As Integer x,y,a,x1,y1,SubSampleCount,x2,y2
Dim Shared As VectorType LightSource
Dim Shared Corners(0 To 3) As SubSampleType
Dim Shared SubSamples(Int(SCR_W/SampleSize)+1,Int(SCR_H/SampleSize)+1) As SubSampleType
Dim BounceSphere As Single
Dim As Integer s,s1
Dim Shared LastShadowCaster As Integer
Dim As double StartTime, endtime, fps
Dim Shared As Integer ErrorCutOff
Dim Key$
Dim RayColour As SubSampleType

'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************                                                ************************************
'**************************                   MAIN CODE                    ************************************
'**************************                                                ************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************

Screen 15,32,2
s=0:s1=1
ScreenSet s,s1

'Randomize Timer
Randomize -8


'Light Source
LightSource.x = 300
LightSource.y = -100
LightSource.z = -200
 
'View point
MyRay.origin.x=SCR_W/2
MyRay.origin.y=SCR_H/2 - 10
MyRay.origin.z=-ViewDistance
MyRay.ShadowRay = FALSE ' This ray is not checking InShadow
MyRay.CurrentObject=-1

SetupScene

ErrorCutOff = 40


Do
  starttime = timer
  BounceSphere=BounceSphere+.2
  For a=1 To NUMSPHERES
    If a<>1 Then Spheres(a).Centre.Y=140-Abs(Sin(BounceSphere+a)*90+a)
    Spheres(a).cx=SCR_W/2+((Spheres(a).Centre.x-MyRay.Origin.x)*ViewDistance)/(Spheres(a).Centre.z+ViewDistance)
    Spheres(a).cy=SCR_H/2-10+((Spheres(a).Centre.y-MyRay.Origin.y)*ViewDistance)/(Spheres(a).Centre.z+ViewDistance)
    Spheres(a).ProjectedRadiusSquared=((Spheres(a).Radius)*ViewDistance*1.15)/(Spheres(a).Centre.z+ViewDistance)
    Spheres(a).ProjectedRadiusSquared=Spheres(a).ProjectedRadiusSquared*Spheres(a).ProjectedRadiusSquared
  Next a

  '**********************************************************************
  '**********************************************************************
  '**********************************************************************
  '*******************************  RENDER  *****************************
  '**********************************************************************
  '**********************************************************************
  '**********************************************************************
  SubSampleCount=0
  x1=0
  y1=0
  For y=0 To SCR_H Step SampleSize
    For x=0 To SCR_W Step SampleSize
      MyRay.dir.x = x - MyRay.origin.x
      MyRay.dir.y = y - MyRay.origin.y
      MyRay.dir.z = - MyRay.origin.z
      MyRay.dir = Vec_Normalize(MyRay.Dir)
      MyRay.ScreenX = x
      MyRay.ScreenY = y
      MyRay.CurrentObject=0
      SubSamples(x1,y1) = GetRayColour(MyRay)
      Pset(x,y),SubSamples(x1,y1).Colour
      x1+=1
    Next x
    y1+=1
    x1=0
  Next y

  x1=0
  y1=0
  For y=0 To SCR_H Step SampleSize
    For x=0 To SCR_W Step SampleSize
      Corners(0)=SubSamples(x1,y1)
      Corners(1)=SubSamples(x1+1,y1)
      Corners(2)=SubSamples(x1,y1+1)
      Corners(3)=SubSamples(x1+1,y1+1)
      If CornersAreSame Then
        SubSampleCount+=(SampleSize*SampleSize)-4
        InterpolateSquare x,y,SampleSize
      Else
        MyRay.CurrentObject=0
        For y2=0 To SampleSize-1
          For x2=0 To SampleSize-1
            'Setup Ray for each screen pixel
            MyRay.dir.x = (x+x2) - MyRay.origin.x
            MyRay.dir.y = (y+y2) - MyRay.origin.y
            MyRay.dir.z = - MyRay.origin.z
            MyRay.dir = Vec_Normalize(MyRay.Dir)
            MyRay.ScreenX = x+x2
            MyRay.ScreenY = y+y2
            RayColour = GetRayColour(MyRay)
            Pset (x2+x,y2+y),RayColour.Colour
          Next x2
        Next y2
      End If
      x1+=1
    Next x
    y1+=1
    x1=0
  Next y
 
  Key$=Inkey$
  If Key$=Chr$(27) Then Exit Do
 
  Color rgb(68,128,255)
  Locate 28,1:? " Sub sample results"
  Color rgb(255,255,255)
  Print SCR_W*SCR_H;" -";SubSampleCount;" =";SCR_W*SCR_H-SubSampleCount
  Color rgb(128,128,255)
  Print " Total Skipped   Calculated Rays"
  Color rgb(212,212,255)
  Locate 32,1:? " FPS:";FPS
  Color rgb(255,212,212)
  Locate 34,1:? " Image quality:";ErrorCutOff;"   "
  Color rgb(Rnd(1)*155+100,Rnd(1)*155+100,Rnd(1)*155+100)
  Print " Press 1-5 to change quality"
  Select Case Key$
    Case Is = "1"
      ErrorCutOff = 0
    Case Is = "2"
      ErrorCutOff = 15
    Case Is = "3"
      ErrorCutOff = 40
    Case Is = "4"
      ErrorCutOff = 65
    Case Is = "5"
      ErrorCutOff = 130
  End Select

  Swap s,s1
  ScreenSet s,s1
  endtime = timer
  fps = 1/(endtime-starttime)
Loop



'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************                                                ************************************
'**************************            FUNCTIONS AND SUBS                  ************************************
'**************************                                                ************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************

Function Vec_Normalize(v As VectorType) As VectorType
  Dim l As Single
 
  l=1.0/Sqr(v.x*v.x+v.y*v.y+v.z*v.z)

  v.x=v.x*l
  v.y=v.y*l
  v.z=v.z*l

  Vec_Normalize = v
End Function

Function FindClosestIntersection(Ray As RayType) As InterSectionType
  Dim Result As InterSectionType
  Dim As Integer a,xd,yd
  Dim Intersect As InterSectionType

  'Set the default return values
  Result.Dist=-1
  Result.Object=-1

  If Ray.CurrentObject=0 Then
    For a=1 To NUMSPHERES
      'Optimization  - Check if squared distance from this ray to centre of sphere is >radius
      xd = Spheres(a).cx - Ray.ScreenX
      yd = Spheres(a).cy - Ray.ScreenY
      If (xd*xd+yd*yd) > Spheres(a).ProjectedRadiusSquared Then
        Intersect.Dist = -1
      Else
        Intersect = SphereIntersect(Ray, Spheres(a))
        If Intersect.Dist>0 Then
          If Result.Dist<>-1 Then
            If Intersect.Dist < Result.Dist Then
              Result.Dist = Intersect.Dist
              Result.Object = a
              Result.ObjectType = SPH
              Result.u = Intersect.u
              Result.v = Intersect.v
            End If
          Else
            Result.Dist = Intersect.Dist
            Result.Object = a
            Result.ObjectType = SPH
            Result.u = Intersect.u
            Result.v = Intersect.v
          End If
        End If
      End If
    Next a
  Else
    For a=1 To NUMSPHERES
      If a=Ray.CurrentObject Then
        Intersect.Dist=-1
      Else
        Intersect = SphereIntersect(Ray, Spheres(a))
        If Intersect.Dist>0 Then
          If Result.Dist<>-1 Then
            If Intersect.Dist < Result.Dist Then
              Result.Dist = Intersect.Dist
              Result.Object = a
              Result.ObjectType = SPH
              Result.u = Intersect.u
              Result.v = Intersect.v
            End If
          Else
            Result.Dist = Intersect.Dist
            Result.Object = a
            Result.ObjectType = SPH
            Result.u = Intersect.u
            Result.v = Intersect.v
          End If
        End If
      End If
    Next a
  End If
  FindClosestIntersection = Result
End Function

Function InShadow(ShadowRay As RayType) As InterSectionType
  Dim Intersect As IntersectionType
  Dim As Integer a,a1

  Intersect.Dist = -1
  If LastShadowCaster=0 Then
    a1=2: 'Object 1 is the light source
  Else
    a1=LastShadowCaster
  End If
  For a=2 To NUMSPHERES
    'The next check is so we don't check for intersections with the intersect point object
    If a1<>ShadowRay.CurrentObject Then
      Intersect = SphereIntersect(ShadowRay, Spheres(a1))
      If Intersect.Dist>0 Then
        Intersect.Dist = 1
        InShadow = Intersect
        Exit Function
      End If
    End If
    a1=a1+1:If a1>NUMSPHERES Then a1=2: 'Object 1 is the light source
  Next a
  InShadow = Intersect
End Function

Function SphereIntersect(R As RayType, S As SphereType) As IntersectionType
  Dim Result As IntersectionType
  Dim As VectorType rayToSphereCentre
  Dim As Single SquaredDistToCentre, ClosestApproach, HalfCord2
 
  rayToSphereCentre.x = S.Centre.x-R.Origin.x
  rayToSphereCentre.y = S.Centre.y-R.Origin.y
  rayToSphereCentre.z = S.Centre.z-R.Origin.z
  SquaredDistToCentre = Vec_DotProduct(rayToSphereCentre, rayToSphereCentre)

  ClosestApproach = Vec_DotProduct(rayToSphereCentre, R.Dir)
  If ClosestApproach<0 Then
    Result.Dist=-1
    SphereIntersect = Result
    Exit Function
  End If

  HalfCord2 = (S.Radius * S.Radius) - SquaredDistToCentre + (ClosestApproach * ClosestApproach)

  If HalfCord2 < 0 Then
    Result.Dist=-1
    SphereIntersect = Result
    Exit Function
  End If
   
  Result.Dist = ClosestApproach - Sqr(Halfcord2)
  SphereIntersect = Result
End Function

Function Vec_Subtract(v1 As VectorType, v2 As VectorType) As VectorType
  Dim Result As VectorType
 
  Result.x = v1.x - v2.x
  Result.y = v1.y - v2.y
  Result.z = v1.z - v2.z

  Vec_Subtract = Result
End Function

Sub SetupScene
  Dim a As Integer

  'Now the spheres
  If NUMSPHERES>0 Then
    For a=1 To NUMSPHERES
      Spheres(a).Centre.x = Int(Rnd(1)*(SCR_W-100))+50
      Spheres(a).Centre.y = Int(Rnd(1)*SCR_H/2)+SCR_H/2
      Spheres(a).Centre.z = Int(Rnd(1)*SCR_H)-SCR_H/2
      Spheres(a).Radius = 35
      Spheres(a).r=Int(Rnd(1)*200)+55
      Spheres(a).g=Int(Rnd(1)*200)+55
      Spheres(a).b=Int(Rnd(1)*200)+55
    Next a
  End If

  'Make sphere 1 the light source
  Spheres(1).Centre = LightSource
  Spheres(1).Radius = 25

  Spheres(1).r=255
  Spheres(1).g=255
  Spheres(1).b=255
End Sub

Function CalculateColour(Object As Integer, ObjectType As Integer, Ray As RayType, L As Single) As ColourCalc
  Dim As Single DP,SpecRDT,Spec,Shade,SpecDOT
  Dim As VectorType IL,SpecR,SpecV
  Dim As IntersectionType AnIntersection
  Dim As RayType ARay
  Dim As Integer R,G,B
  Dim Result As ColourCalc
 
  'Get the intersection point
  Result.IP.x=Ray.Origin.x + Ray.Dir.x * L
  Result.IP.y=Ray.Origin.y + Ray.Dir.y * L
  Result.IP.z=Ray.Origin.z + Ray.Dir.z * L

  'Create a vector from the intersection point to the light source
  IL = Vec_Normalize(Vec_Subtract(LightSource,Result.IP))
 
  'Get the dot product of the normal and this new vector
  Result.N = Vec_Normalize(Vec_Subtract(Result.IP,Spheres(Object).Centre))

  DP = (Vec_DotProduct(IL, Result.N))+.2
  If DP>0 Then
    'Check if intersection point is in the shadow of another object
    ARay.Origin = Result.IP
    ARay.Dir = IL
    ARay.CurrentObject = Object
    ARay.CurrentObjectType = ObjectType
    AnIntersection = InShadow(ARay)
   
    'In shadow?
    Result.Shadowed=1
    If AnIntersection.Dist>0 Then
      'Use these results to calc the light value
      DP=DP*.25
      Result.Shadowed = 0
    End If

    'Calculate Specular
    Spec=0
    SpecV.x = 0
    SpecV.y = 0
    SpecV.z = Sgn(ViewDistance)
    SpecRDT = 2 * Vec_DotProduct( IL, Result.N )
    SpecR.x = IL.x - SpecRDT * Result.N.x
    SpecR.y = IL.y - SpecRDT * Result.N.y
    SpecR.z = IL.z - SpecRDT * Result.N.z
    SpecDOT = Vec_DotProduct(SpecV, SpecR)
    If SpecDOT > 0.0 Then
      Spec = SpecDOT ^ 20 * 0.55 * Result.Shadowed * 255
    End If

    r=Spheres(Object).r * dp + spec
    g=Spheres(Object).g * dp + spec
    b=Spheres(Object).b * dp + spec

    If r>255 Then r = 255
    If g>255 Then g = 255
    If b>255 Then b = 255

    Result.Colour.r = r
    Result.Colour.g = g
    Result.Colour.b = b
  Else
    Result.Colour.r = 0
    Result.Colour.g = 0
    Result.Colour.b = 0
  End If
  CalculateColour = Result
End Function

Function CornersAreSame As Integer
  Dim As Ubyte r,g,b,r1,g1,b1,a
 
  If Corners(0).Object=Corners(1).Object Then
    If Corners(0).Object=Corners(2).Object Then
      If Corners(0).Object=Corners(3).Object Then
        If Corners(0).Shadowed<>Corners(1).Shadowed Or Corners(0).Shadowed<>Corners(2).Shadowed Or Corners(0).Shadowed<>Corners(3).Shadowed Then
          CornersAreSame=FALSE
          Exit Function
        End If

        r=(Corners(0).Colour Shr 16) And 255
        g=(Corners(0).Colour Shr 8) And 255
        b=Corners(0).Colour And 255
     
        For a=1 To 3
          r1=(Corners(a).Colour Shr 16) And 255
          g1=(Corners(a).Colour Shr 8) And 255
          b1=Corners(a).Colour And 255
          If Abs(r1-r)>ErrorCutoff Then
            CornersAreSame=FALSE
            Exit Function
          End If
          If Abs(g1-g)>ErrorCutoff Then
            CornersAreSame=FALSE
            Exit Function
          End If
          If Abs(b1-b)>ErrorCutoff Then
            CornersAreSame=FALSE
            Exit Function
          End If
        Next a
        CornersAreSame=TRUE
        Exit Function
      Else
        CornersAreSame=FALSE
        Exit Function
      End If
    Else
      CornersAreSame=FALSE
      Exit Function
    End If
  Else
    CornersAreSame=FALSE
    Exit Function
  End If
End Function

Sub InterpolateSquare(sx,sy,sqSize As Single)
  Dim c1 As RGBType
  Dim As Single rs,gs,bs
  Dim c(3) As RGBType
  Dim As Integer ca,cb,car,cab,cag,cbr,cbg,cbb,x,y
 
  For x=0 To 3
    c(x).r = (Corners(x).Colour Shr 16) And 255
    c(x).g = (Corners(x).Colour Shr 8) And 255
    c(x).b = Corners(x).Colour And 255
  Next x
 
  y=0
  rs=(c(1).r-c(0).r)/sqSize
  gs=(c(1).g-c(0).g)/sqSize
  bs=(c(1).b-c(0).b)/sqSize
  For x=0 To sqSize
    c1.r=c(0).r+x*rs
    c1.g=c(0).g+x*gs
    c1.b=c(0).b+x*bs
    Pset (x+sx,y+sy),RGB(c1.r,c1.g,c1.b)
  Next x
 
  y=sqSize
  rs=(c(3).r-c(2).r)/sqSize
  gs=(c(3).g-c(2).g)/sqSize
  bs=(c(3).b-c(2).b)/sqSize
  For x=0 To sqSize
    c1.r=c(2).r+x*rs
    c1.g=c(2).g+x*gs
    c1.b=c(2).b+x*bs
    Pset (x+sx,y+sy),RGB(c1.r,c1.g,c1.b)
  Next x
 
  For x=0 To sqSize
    ca=Point(x+sx,sy)
    cb=Point(x+sx,sqSize+sy)
    car=(ca Shr 16) And 255
    cag=(ca Shr 8) And 255
    cab=ca And 255
    cbr=(cb Shr 16) And 255
    cbg=(cb Shr 8) And 255
    cbb=cb And 255
    rs=(cbr-car)/sqSize
    gs=(cbg-cag)/sqSize
    bs=(cbb-cab)/sqSize
    For y=1 To sqSize-1
      c1.r=car+y*rs
      c1.g=cag+y*gs
      c1.b=cab+y*bs
      Pset (x+sx,y+sy),RGB(c1.r,c1.g,c1.b)
    Next y
  Next x
End Sub

Function ReflectRay(V As RayType, IP As VectorType, N As VectorType) As RayType
  Dim Result As RayType
  Dim Dot As Single
 
  Result.Origin = IP
  Dot = 2 * Vec_DotProduct(V.Dir, N)
  Result.Dir.x = V.Dir.x - Dot * N.x
  Result.Dir.y = V.Dir.y - Dot * N.y
  Result.Dir.z = V.Dir.z - Dot * N.z
  Result.Dir = Vec_Normalize(Result.Dir)

  ReflectRay = Result
End Function

Function GetRayColour(MyRay As RayType) As SubSampleType
  Dim As RayType MyReflectedRay
  Dim As IntersectionType MyIntersection,MyIntersection2
  Dim As ColourCalc Colour, Colour2
  Dim Result As SubSampleType

  MyIntersection = FindClosestIntersection(MyRay)
  If MyIntersection.Dist>0 Then
    Colour = CalculateColour(MyIntersection.Object,MyIntersection.ObjectType,MyRay,MyIntersection.Dist)
    MyReflectedRay = ReflectRay(MyRay, Colour.IP, Colour.N)
    MyReflectedRay.CurrentObject = MyIntersection.Object
    MyIntersection2 = FindClosestIntersection(MyReflectedRay)
    If MyIntersection2.Dist>0 Then
      Colour2 = CalculateColour(MyIntersection2.Object,MyIntersection2.ObjectType,MyReflectedRay,MyIntersection2.Dist)
      Colour.Colour.r = Colour.Colour.r + Colour2.Colour.r/2:If Colour.Colour.r>255 Then Colour.Colour.r=255
      Colour.Colour.g = Colour.Colour.g + Colour2.Colour.g/2:If Colour.Colour.g>255 Then Colour.Colour.g=255
      Colour.Colour.b = Colour.Colour.b + Colour2.Colour.b/2:If Colour.Colour.b>255 Then Colour.Colour.b=255
    Else
      Colour.Colour.r = Colour.Colour.r+10:If Colour.Colour.r>255 Then Colour.Colour.r=255
      Colour.Colour.g = Colour.Colour.g+10:If Colour.Colour.g>255 Then Colour.Colour.g=255
      Colour.Colour.b = Colour.Colour.b+10:If Colour.Colour.b>255 Then Colour.Colour.b=255
    End If
    Result.Colour = RGB(Colour.Colour.r,Colour.Colour.g,Colour.Colour.b)
    Result.Shadowed = Colour.Shadowed
    Result.Object = MyIntersection.Object
  Else
    Result.Colour = RGB(20,20,20)
    Result.Shadowed = FALSE
    Result.Object = -1
  End If
  GetRayColour = Result
End Function
quality 5: ~17 FPS
quality 1: ~9 FPS

on an Intel P4 3.0GHz (northwood HT core) with 1536MB RAM
Top
1000101
Posts: 2556
Joined: Jun 13, 2005 23:14
Location: SK, Canada

Post by 1000101 »

Edit:

Changes made:

+ Like ikkejw, I also adjusted the fps counter (to change 1/sec so you get a better idea of the overall speed).
+ I further changed to to lock and unlock the screen using a single page instead of page flipping.
+ I changed all the costly string compares and the "inkey" to the much faster "MultiKey".
+ I also made various other tweaks and tightened up things a little to improve preformance.
+ I changed the code slightly to compile under .17, although it should still compiler under .16 (not that you're using .16, right?).
+ As an after though, I went over the the "General" forum and grabbed one of the faster pixel plotters (compared to PSET) and got a massive speed increase. I then replaced all the POINT commands with the pixel plotter equivalent to reduce overhead and increase throughput.

Anyway, with my changes it runs almost 2x faster (the gain is bigger as the quality increases).

Original code (with ikkejw's fps counter and .17 compliancy):
Quality 1 (0): ~8.5 FPS
Quality 5 (130): ~17.5 FPS


Tricked-out, tweaked-out version:
Quality 1 (0): ~16.5 FPS
Quality 5 (130): ~32 FPS

AthlonXP 2500+ (Barton Core (512K L2 cache), 1.8GHz, 333MHz FSB)

Code: Select all

'$stop_scan
'Realtime Ray Tracer v0.2
'by Voltage 
'Started 21/3/2007
'Last update 2/5/2007
'Compiles with FreeBasic v0.16 (Tested on Win 32)

'DONE! - Cast a ray through each screen coord
'DONE! - Check for intersection with triangle
'DONE! - Find closest object that intersected
'DONE! - Draw appropriate diffuse colour
'DONE! - Basic Shadows (hard edges)
'DONE! - Spheres
'DONE! - Specular lighting
'DONE! - Improve the sub sampler
'DONE! - Interpolate between sub sample corners, instead of the quick and dirty rectangle in colour 0
'DONE! - Quicker sphere intersection test (2d bounding circle check)
'DONE! - Reflection
'DONE! - Clean up code for recursion and optimisation
'DONE! - Fix sub sample metric code to check if corners are all in or all out of shadow / ugly shadow bug

'*** STILL TO DO ***
'Adaptive subsampling - Instead of crappy 6x6 non adaptive
'Optimise for multiple processors
'Recursive reflections
'Texture maps
'Add Plane object
'Add Cylinder object
'Add CSG

#include once "fbgfx.bi"
Using fb

#Macro QuickPixel( X, Y, C )
   
   Scope
      
      Dim As Integer   pX = ( X )
      Dim As Integer   pY = ( Y )
      
      If ( pX >= 0 ) And ( pX < ( SCR_W ) ) And ( pY >= 0 ) And ( pY < ( SCR_H ) ) Then
         
         Dim As uInteger Ptr   pPix = ScreenPtr + ( ( pY * SCR_W ) Shl 2 )
         
         pPix[ pX ] = C
         
      End If
      
   End Scope
   
#EndMacro

#Macro QuickPoint( C, X, Y )
   
   Scope
      
      Dim As Integer   pX = ( X )
      Dim As Integer   pY = ( Y )
      
      If ( pX >= 0 ) And ( pX < ( SCR_W ) ) And ( pY >= 0 ) And ( pY < ( SCR_H ) ) Then
         
         Dim As uInteger Ptr   pPix = ScreenPtr + ( ( pY * SCR_W ) Shl 2 )
         
         C = pPix[ pX ]
         
      End If
      
   End Scope
   
#EndMacro

#define Vec_DotProduct(v1,v2) (v1.x*v2.x + v1.y*v2.y + v1.z*v2.z)

Type VectorType
   x As Single
   y As Single
   z As Single
End Type

Type RayType
   origin As VectorType
   dir As VectorType
   ShadowRay As Integer
   CurrentObject As Integer
   CurrentObjectType As Integer
   ScreenX As Integer
   ScreenY As Integer
End Type

Type IntersectionType
   Dist As Single
   Object As Integer
   ObjectType As Integer
   u As Single
   v As Single
End Type

Type TriangleType
   v1 As VectorType 
   v2 As VectorType
   v3 As VectorType
   Plane As RayType
   R As Ubyte
   G As Ubyte
   B As Ubyte
End Type

Type SphereType
   Centre As VectorType
   Radius As Single
   R As Ubyte
   G As Ubyte
   B As Ubyte
   cx As Integer
   cy As Integer
   ProjectedRadiusSquared As Integer
End Type

Type SubSampleType
   Colour As Uinteger
   Object As Integer
   Shadowed As Integer
End Type

Type RGBType
   r As Integer
   g As Integer
   b As Integer
End Type

Type ColourCalc
   Colour As RGBType
   Shadowed As Integer
   IP As VectorType 
   N As VectorType
End Type

Declare Function Vec_Normalize(v As VectorType) As VectorType
Declare Function FindClosestIntersection(Ray As RayType) As InterSectionType
Declare Function SphereIntersect(R As RayType, S As SphereType) As IntersectionType
Declare Function Vec_Subtract(v1 As VectorType, v2 As VectorType) As VectorType
Declare Sub SetupScene
Declare Function CalculateColour(Object As Integer, ObjectType As Integer, R As RayType, L As Single) As ColourCalc
Declare Function CornersAreSame As Integer
Declare Sub InterpolateSquare(sx As Integer,sy As Integer,sqSize As Single)
Declare Function InShadow(ShadowRay As RayType) As InterSectionType
Declare Function ReflectRay(V As RayType, IP As VectorType, N As VectorType) As RayType
Declare Function GetRayColour(MyRay As RayType) As SubSampleType

Const SCR_W=320
Const SCR_H=240
Const ViewDistance = SCR_W
Const NUMSPHERES = 9 'The first sphere is the light source
Const EPSILON=0.000001
Const FALSE = 0
Const TRUE = Not FALSE
Const SP=2
Const SampleSize = 6
Const SPH = 2

Dim As RayType MyRay, MyReflectedRay 
Dim As IntersectionType MyIntersection,MyIntersection2
Dim As ColourCalc Colour, Colour2
Dim Shared Spheres(1 To NUMSPHERES) As SphereType
Dim As Integer x,y,a,x1,y1,SubSampleCount,x2,y2
Dim Shared As VectorType LightSource
Dim Shared Corners(0 To 3) As SubSampleType
Dim Shared SubSamples(Int(SCR_W/SampleSize)+1,Int(SCR_H/SampleSize)+1) As SubSampleType
Dim BounceSphere As Single
Dim As Integer Ticks
Dim Shared LastShadowCaster As Integer
Dim As Single StartTime,EndTime,FPS
Dim Shared As Integer ErrorCutOff
Dim RayColour As SubSampleType

'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************                                                ************************************
'**************************                   MAIN CODE                    ************************************
'**************************                                                ************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************

ScreenRes SCR_W, SCR_H, 32

Randomize Timer
'Randomize -8


'Light Source
LightSource.x = 300
LightSource.y = -100
LightSource.z = -200

'View point
MyRay.origin.x=SCR_W/2
MyRay.origin.y=SCR_H/2 - 10
MyRay.origin.z=-ViewDistance
MyRay.ShadowRay = FALSE ' This ray is not checking InShadow
MyRay.CurrentObject=-1

SetupScene

ErrorCutOff = 40

StartTime=Timer
Do
   ScreenLock
   BounceSphere=BounceSphere+.2
   For a=1 To NUMSPHERES
      If a<>1 Then Spheres(a).Centre.Y=140-Abs(Sin(BounceSphere+a)*90+a)
      Spheres(a).cx=SCR_W/2+((Spheres(a).Centre.x-MyRay.Origin.x)*ViewDistance)/(Spheres(a).Centre.z+ViewDistance)
      Spheres(a).cy=SCR_H/2-10+((Spheres(a).Centre.y-MyRay.Origin.y)*ViewDistance)/(Spheres(a).Centre.z+ViewDistance)
      Spheres(a).ProjectedRadiusSquared=((Spheres(a).Radius)*ViewDistance*1.15)/(Spheres(a).Centre.z+ViewDistance)
      Spheres(a).ProjectedRadiusSquared=Spheres(a).ProjectedRadiusSquared*Spheres(a).ProjectedRadiusSquared
   Next a
   
   '**********************************************************************
   '**********************************************************************
   '**********************************************************************
   '*******************************  RENDER  *****************************
   '**********************************************************************
   '**********************************************************************
   '**********************************************************************
   SubSampleCount=0
   x1=0
   y1=0
   For y=0 To SCR_H Step SampleSize
      For x=0 To SCR_W Step SampleSize
         MyRay.dir.x = x - MyRay.origin.x
         MyRay.dir.y = y - MyRay.origin.y
         MyRay.dir.z = - MyRay.origin.z
         MyRay.dir = Vec_Normalize(MyRay.Dir)
         MyRay.ScreenX = x
         MyRay.ScreenY = y
         MyRay.CurrentObject=0
         SubSamples(x1,y1) = GetRayColour(MyRay)
         QuickPixel( X, Y, SubSamples(x1,y1).Colour )
         'Pset(x,y),SubSamples(x1,y1).Colour
         x1+=1
      Next x
      y1+=1
      x1=0
   Next y
   
   x1=0
   y1=0
   For y=0 To SCR_H - 80 Step SampleSize
      For x=0 To SCR_W Step SampleSize
         Corners(0)=SubSamples(x1,y1)
         Corners(1)=SubSamples(x1+1,y1)
         Corners(2)=SubSamples(x1,y1+1)
         Corners(3)=SubSamples(x1+1,y1+1)
         If CornersAreSame Then
            SubSampleCount+=(SampleSize*SampleSize)-4
            InterpolateSquare x,y,SampleSize
         Else
            MyRay.CurrentObject=0
            For y2=0 To SampleSize-1
               For x2=0 To SampleSize-1
                  'Setup Ray for each screen pixel
                  MyRay.dir.x = (x+x2) - MyRay.origin.x
                  MyRay.dir.y = (y+y2) - MyRay.origin.y
                  MyRay.dir.z = - MyRay.origin.z
                  MyRay.dir = Vec_Normalize(MyRay.Dir)
                  MyRay.ScreenX = x+x2
                  MyRay.ScreenY = y+y2
                  RayColour = GetRayColour(MyRay)
                  QuickPixel( x2+x, y2+y, RayColour.Colour )
                  'Pset (x2+x,y2+y),RayColour.Colour
               Next x2
            Next y2
         End If
         x1+=1
      Next x
      y1+=1
      x1=0
   Next y
   
   If MultiKey( SC_ESCAPE ) Then Exit Do
   
   Color rgb(68,128,255)
   Locate (SCR_H \ 8) - 8,1:? " Sub sample results"
   Color rgb(255,255,255)
   Print SCR_W*SCR_H;" -";SubSampleCount;" =";SCR_W*SCR_H-SubSampleCount
   Color rgb(128,128,255)
   Print " Total Skipped   Calculated Rays"
   Color rgb(212,212,255)
   Locate (SCR_H \ 8) - 4,1:? " FPS:";FPS
   Color rgb(255,212,212)
   Locate (SCR_H \ 8) - 2,1:? " Image quality:";ErrorCutOff;"   "
   Color rgb(Rnd(1)*155+100,Rnd(1)*155+100,Rnd(1)*155+100)
   Print " Press 1-5 to change quality"
   If MultiKey( SC_1 ) Then ErrorCutOff = 0
   If MultiKey( SC_2 ) Then ErrorCutOff = 15
   If MultiKey( SC_3 ) Then ErrorCutOff = 40
   If MultiKey( SC_4 ) Then ErrorCutOff = 65
   If MultiKey( SC_5 ) Then ErrorCutOff = 130
   
   ScreenUnlock
   endtime = Timer
   ticks += 1
   If ( ( EndTime - StartTime ) >= 1.0 ) Then
      fps = ticks/(endtime-starttime)
      ticks = 0
      starttime = endtime
   End If
Loop
ScreenUnlock

End


'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************                                                ************************************
'**************************            FUNCTIONS AND SUBS                  ************************************
'**************************                                                ************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************
'**************************************************************************************************************

Function Vec_Normalize(v As VectorType) As VectorType
   Dim l As Single
   
   l=1.0/Sqr(v.x*v.x+v.y*v.y+v.z*v.z)
   
   v.x=v.x*l
   v.y=v.y*l
   v.z=v.z*l
   
   Vec_Normalize = v
End Function

Function FindClosestIntersection(Ray As RayType) As InterSectionType
   Dim Result As InterSectionType
   Dim As Integer a,xd,yd
   Dim Intersect As InterSectionType
   
   'Set the default return values
   Result.Dist=-1
   Result.Object=-1
   
   If Ray.CurrentObject=0 Then
      For a=1 To NUMSPHERES
         'Optimization  - Check if squared distance from this ray to centre of sphere is >radius
         xd = Spheres(a).cx - Ray.ScreenX
         yd = Spheres(a).cy - Ray.ScreenY
         If (xd*xd+yd*yd) > Spheres(a).ProjectedRadiusSquared Then
            Intersect.Dist = -1
         Else
            Intersect = SphereIntersect(Ray, Spheres(a))
            If Intersect.Dist>0 Then 
               If Result.Dist<>-1 Then
                  If Intersect.Dist < Result.Dist Then
                     Result.Dist = Intersect.Dist
                     Result.Object = a
                     Result.ObjectType = SPH
                     Result.u = Intersect.u
                     Result.v = Intersect.v
                  End If
               Else
                  Result.Dist = Intersect.Dist
                  Result.Object = a
                  Result.ObjectType = SPH
                  Result.u = Intersect.u
                  Result.v = Intersect.v
               End If
            End If
         End If
      Next a
   Else
      For a=1 To NUMSPHERES
         If a=Ray.CurrentObject Then
            Intersect.Dist=-1
         Else
            Intersect = SphereIntersect(Ray, Spheres(a))
            If Intersect.Dist>0 Then 
               If Result.Dist<>-1 Then
                  If Intersect.Dist < Result.Dist Then
                     Result.Dist = Intersect.Dist
                     Result.Object = a
                     Result.ObjectType = SPH
                     Result.u = Intersect.u
                     Result.v = Intersect.v
                  End If
               Else
                  Result.Dist = Intersect.Dist
                  Result.Object = a
                  Result.ObjectType = SPH
                  Result.u = Intersect.u
                  Result.v = Intersect.v
               End If
            End If
         End If
      Next a
   End If
   FindClosestIntersection = Result
End Function

Function InShadow(ShadowRay As RayType) As InterSectionType
   Dim Intersect As IntersectionType
   Dim As Integer a,a1
   
   Intersect.Dist = -1
   If LastShadowCaster=0 Then
      a1=2: 'Object 1 is the light source
   Else
      a1=LastShadowCaster
   End If
   For a=2 To NUMSPHERES
      'The next check is so we don't check for intersections with the intersect point object
      If a1<>ShadowRay.CurrentObject Then
         Intersect = SphereIntersect(ShadowRay, Spheres(a1))
         If Intersect.Dist>0 Then 
            Intersect.Dist = 1
            InShadow = Intersect
            Exit Function
         End If
      End If
      a1=a1+1:If a1>NUMSPHERES Then a1=2: 'Object 1 is the light source
   Next a
   InShadow = Intersect
End Function

Function SphereIntersect(R As RayType, S As SphereType) As IntersectionType
   Dim Result As IntersectionType
   Dim As VectorType rayToSphereCentre
   Dim As Single SquaredDistToCentre, ClosestApproach, HalfCord2
   
   rayToSphereCentre.x = S.Centre.x-R.Origin.x
   rayToSphereCentre.y = S.Centre.y-R.Origin.y
   rayToSphereCentre.z = S.Centre.z-R.Origin.z
   SquaredDistToCentre = Vec_DotProduct(rayToSphereCentre, rayToSphereCentre)
   
   ClosestApproach = Vec_DotProduct(rayToSphereCentre, R.Dir)
   If ClosestApproach<0 Then
      Result.Dist=-1
      SphereIntersect = Result
      Exit Function
   End If
   
   HalfCord2 = (S.Radius * S.Radius) - SquaredDistToCentre + (ClosestApproach * ClosestApproach)
   
   If HalfCord2 < 0 Then
      Result.Dist=-1
      SphereIntersect = Result
      Exit Function
   End If
   
   Result.Dist = ClosestApproach - Sqr(Halfcord2)
   SphereIntersect = Result
End Function

Function Vec_Subtract(v1 As VectorType, v2 As VectorType) As VectorType
   Dim Result As VectorType
   
   Result.x = v1.x - v2.x
   Result.y = v1.y - v2.y
   Result.z = v1.z - v2.z
   
   Vec_Subtract = Result
End Function

Sub SetupScene
   Dim a As Integer
   
   'Now the spheres
   If NUMSPHERES>0 Then
      For a=1 To NUMSPHERES
         Spheres(a).Centre.x = Int(Rnd*(SCR_W-128))+64
         Spheres(a).Centre.y = Int(Rnd* SCR_H     )
         Spheres(a).Centre.z = Int(Rnd*(SCR_H- 80))
         Spheres(a).Radius = 35
         Spheres(a).r=Int(Rnd*200)+55
         Spheres(a).g=Int(Rnd*200)+55
         Spheres(a).b=Int(Rnd*200)+55
      Next a
   End If
   
   'Make sphere 1 the light source
   Spheres(1).Centre = LightSource
   Spheres(1).Radius = 25
   
   Spheres(1).r=255
   Spheres(1).g=255
   Spheres(1).b=255
End Sub

Function CalculateColour(Object As Integer, ObjectType As Integer, Ray As RayType, L As Single) As ColourCalc
   Dim As Single DP,SpecRDT,Spec,Shade,SpecDOT
   Dim As VectorType IL,SpecR,SpecV
   Dim As IntersectionType AnIntersection
   Dim As RayType ARay
   Dim As Integer R,G,B
   Dim Result As ColourCalc
   
   'Get the intersection point
   Result.IP.x=Ray.Origin.x + Ray.Dir.x * L
   Result.IP.y=Ray.Origin.y + Ray.Dir.y * L
   Result.IP.z=Ray.Origin.z + Ray.Dir.z * L
   
   'Create a vector from the intersection point to the light source
   IL = Vec_Normalize(Vec_Subtract(LightSource,Result.IP))
   
   'Get the dot product of the normal and this new vector
   Result.N = Vec_Normalize(Vec_Subtract(Result.IP,Spheres(Object).Centre))
   
   DP = (Vec_DotProduct(IL, Result.N))+.2
   If DP>0 Then
      'Check if intersection point is in the shadow of another object
      ARay.Origin = Result.IP
      ARay.Dir = IL
      ARay.CurrentObject = Object
      ARay.CurrentObjectType = ObjectType
      AnIntersection = InShadow(ARay)
      
      'In shadow?
      Result.Shadowed=1
      If AnIntersection.Dist>0 Then
         'Use these results to calc the light value
         DP=DP*.25
         Result.Shadowed = 0
      End If
      
      'Calculate Specular
      Spec=0
      SpecV.x = 0
      SpecV.y = 0
      SpecV.z = Sgn(ViewDistance)
      SpecRDT = 2 * Vec_DotProduct( IL, Result.N )
      SpecR.x = IL.x - SpecRDT * Result.N.x
      SpecR.y = IL.y - SpecRDT * Result.N.y
      SpecR.z = IL.z - SpecRDT * Result.N.z
      SpecDOT = Vec_DotProduct(SpecV, SpecR)
      If SpecDOT > 0.0 Then
         Spec = SpecDOT ^ 20 * 0.55 * Result.Shadowed * 255
      End If 
      
      r=Spheres(Object).r * dp + spec
      g=Spheres(Object).g * dp + spec
      b=Spheres(Object).b * dp + spec
      
      If r>255 Then r = 255
      If g>255 Then g = 255
      If b>255 Then b = 255
      
      Result.Colour.r = r
      Result.Colour.g = g
      Result.Colour.b = b
   Else
      Result.Colour.r = 0
      Result.Colour.g = 0
      Result.Colour.b = 0
   End If
   CalculateColour = Result
End Function

Function CornersAreSame As Integer
   Dim As Ubyte r,g,b,r1,g1,b1,a 
   
   If Corners(0).Object=Corners(1).Object Then
      If Corners(0).Object=Corners(2).Object Then
         If Corners(0).Object=Corners(3).Object Then
            If Corners(0).Shadowed<>Corners(1).Shadowed Or Corners(0).Shadowed<>Corners(2).Shadowed Or Corners(0).Shadowed<>Corners(3).Shadowed Then
               CornersAreSame=FALSE
               Exit Function
            End If
            
            r=(Corners(0).Colour Shr 16) And 255
            g=(Corners(0).Colour Shr 8) And 255
            b=Corners(0).Colour And 255
            
            For a=1 To 3 
               r1=(Corners(a).Colour Shr 16) And 255
               g1=(Corners(a).Colour Shr 8) And 255
               b1=Corners(a).Colour And 255
               If Abs(r1-r)>ErrorCutoff Then
                  CornersAreSame=FALSE
                  Exit Function
               End If
               If Abs(g1-g)>ErrorCutoff Then
                  CornersAreSame=FALSE
                  Exit Function
               End If
               If Abs(b1-b)>ErrorCutoff Then
                  CornersAreSame=FALSE
                  Exit Function
               End If
            Next a
            CornersAreSame=TRUE
            Exit Function
         Else 
            CornersAreSame=FALSE
            Exit Function
         End If
      Else
         CornersAreSame=FALSE
         Exit Function
      End If
   Else
      CornersAreSame=FALSE
      Exit Function
   End If
End Function

Sub InterpolateSquare(sx As Integer,sy As Integer,sqSize As Single)
   Dim c1 As RGBType
   Dim As Single rs,gs,bs
   Dim c(3) As RGBType
   Dim As Integer ca,cb,car,cab,cag,cbr,cbg,cbb,x,y
   
   For x=0 To 3
      c(x).r = (Corners(x).Colour Shr 16) And 255
      c(x).g = (Corners(x).Colour Shr 8) And 255
      c(x).b = Corners(x).Colour And 255
   Next x
   
   y=0
   rs=(c(1).r-c(0).r)/sqSize
   gs=(c(1).g-c(0).g)/sqSize
   bs=(c(1).b-c(0).b)/sqSize
   For x=0 To sqSize
      c1.r=c(0).r+x*rs
      c1.g=c(0).g+x*gs
      c1.b=c(0).b+x*bs
      QuickPixel( x+sx,y+sy,RGB(c1.r,c1.g,c1.b) )
      'Pset (x+sx,y+sy),RGB(c1.r,c1.g,c1.b) 
   Next x
   
   y=sqSize
   rs=(c(3).r-c(2).r)/sqSize
   gs=(c(3).g-c(2).g)/sqSize
   bs=(c(3).b-c(2).b)/sqSize
   For x=0 To sqSize
      c1.r=c(2).r+x*rs
      c1.g=c(2).g+x*gs
      c1.b=c(2).b+x*bs
      QuickPixel( x+sx,y+sy,RGB(c1.r,c1.g,c1.b) )
      'Pset (x+sx,y+sy),RGB(c1.r,c1.g,c1.b) 
   Next x
   
   For x=0 To sqSize
      QuickPoint(ca,x+sx,sy)
      QuickPoint(cb,x+sx,cint(sqSize+sy))
      'ca=Point(x+sx,sy)
      'cb=Point(x+sx,sqSize+sy)
      car=(ca Shr 16) And 255
      cag=(ca Shr 8) And 255
      cab=ca And 255
      cbr=(cb Shr 16) And 255
      cbg=(cb Shr 8) And 255
      cbb=cb And 255
      rs=(cbr-car)/sqSize
      gs=(cbg-cag)/sqSize
      bs=(cbb-cab)/sqSize
      For y=1 To sqSize-1
         c1.r=car+y*rs
         c1.g=cag+y*gs
         c1.b=cab+y*bs
         QuickPixel( x+sx,y+sy,RGB(c1.r,c1.g,c1.b) )
         'Pset (x+sx,y+sy),RGB(c1.r,c1.g,c1.b) 
      Next y
   Next x
End Sub

Function ReflectRay(V As RayType, IP As VectorType, N As VectorType) As RayType
   Dim Result As RayType
   Dim Dot As Single
   
   Result.Origin = IP
   Dot = 2 * Vec_DotProduct(V.Dir, N)
   Result.Dir.x = V.Dir.x - Dot * N.x
   Result.Dir.y = V.Dir.y - Dot * N.y
   Result.Dir.z = V.Dir.z - Dot * N.z
   Result.Dir = Vec_Normalize(Result.Dir)
   
   ReflectRay = Result
End Function

Function GetRayColour(MyRay As RayType) As SubSampleType
   Dim As RayType MyReflectedRay 
   Dim As IntersectionType MyIntersection,MyIntersection2
   Dim As ColourCalc Colour, Colour2
   Dim Result As SubSampleType
   
   MyIntersection = FindClosestIntersection(MyRay)
   If MyIntersection.Dist>0 Then
      Colour = CalculateColour(MyIntersection.Object,MyIntersection.ObjectType,MyRay,MyIntersection.Dist)
      MyReflectedRay = ReflectRay(MyRay, Colour.IP, Colour.N)
      MyReflectedRay.CurrentObject = MyIntersection.Object
      MyIntersection2 = FindClosestIntersection(MyReflectedRay)
      If MyIntersection2.Dist>0 Then
         Colour2 = CalculateColour(MyIntersection2.Object,MyIntersection2.ObjectType,MyReflectedRay,MyIntersection2.Dist)
         Colour.Colour.r = Colour.Colour.r + Colour2.Colour.r/2:If Colour.Colour.r>255 Then Colour.Colour.r=255
         Colour.Colour.g = Colour.Colour.g + Colour2.Colour.g/2:If Colour.Colour.g>255 Then Colour.Colour.g=255
         Colour.Colour.b = Colour.Colour.b + Colour2.Colour.b/2:If Colour.Colour.b>255 Then Colour.Colour.b=255
      Else
         Colour.Colour.r = Colour.Colour.r+10:If Colour.Colour.r>255 Then Colour.Colour.r=255
         Colour.Colour.g = Colour.Colour.g+10:If Colour.Colour.g>255 Then Colour.Colour.g=255
         Colour.Colour.b = Colour.Colour.b+10:If Colour.Colour.b>255 Then Colour.Colour.b=255
      End If
      Result.Colour = RGB(Colour.Colour.r,Colour.Colour.g,Colour.Colour.b)
      Result.Shadowed = Colour.Shadowed
      Result.Object = MyIntersection.Object
   Else
      Result.Colour = RGB(20,20,20)
      Result.Shadowed = FALSE
      Result.Object = -1
   End If
   GetRayColour = Result
End Function
Top
axipher
Posts: 891
Joined: Dec 27, 2005 16:37
Location: Sudbury,Ontario

Post by axipher »

Quality 1 (0) = ~19 FPS
Quality 5(130) = ~9 FPS
Top
DrV
Site Admin
Posts: 2116
Joined: May 27, 2005 18:39
Location: Midwestern USA
Contact:
Contact DrV

Post by DrV »

With 1000101's changes, I get 32 FPS on quality 3 and 45 FPS on quality 5.
Top
redcrab
Posts: 624
Joined: Feb 07, 2006 15:29
Location: France / Luxemburg
Contact:
Contact redcrab

Post by redcrab »

Waooh ! Kewl
I never knew that real time raytracing was possible
very impressive !

at Quality 0 the reflects are in hight quality
at Quality 5 the reflects are very "squared" or "pixelized"
I've got 9 FPS at 0
I've got 11 FPS at 5
P4 at 2.66 Ghz
compiled with debug info enabled

Keep going guys that's very promising !

That's fun !
Top
Voltage
Posts: 110
Joined: Nov 19, 2005 7:36
Location: Sydney, Australia
Contact:
Contact Voltage

Post by Voltage »

@my FPS counter - Die.

@1000101 - You changed my code for the better. I feel violated AND I am excited about it. :) Is that wrong?

Great job, and thanks for the effort, that is much better. A faster pixel plotter was on the cards but I am suprised that it made that much difference to be honest.

I updated to 0.17 and it compiled nicely after I commented out the line:

Code: Select all

Using fb
It gave an error of: Error 8: Undefined symbol, found: 'fb'

Which means little to me. (Something to so with namespaces?)

Awesome, I'm staggered by the results of these changes, thanks again.
Top
1000101
Posts: 2556
Joined: Jun 13, 2005 23:14
Location: SK, Canada

Post by 1000101 »

"Using" is a namespace thing, yeah. Recent (circa December or so) CVS builds moved gfxlib into the "fb" namespace.

As to your FPS counter, well, it wasn't accurate :P It used a long-term average which is ok for an overall average but not very useful for dynamic changes where you want to see the differences.

Besides, you better get used to this sort of thing on the forum. As soon as you post code, half a dozen people will start playing with it and saying, "hrm, I can tighten that up a bit."
Top
Veggiet
Posts: 156
Joined: Apr 17, 2006 19:41

Post by Veggiet »

very cool, and Nice looking too, after you the the different shapes you could make a simple game. Were you thinking about what you would do with it when your "done." I think that library with a similar syntax of opengl would be nice, except it would be easier, no more point4f, it would be more like sphere x, y, z, r, c!

EDIT: Yes I have heard of glutsphere, but still it would be nice to do basically the same thing as opengl, just nicelly raytraced, and with primitives including Isosurfaces and stuff. Sorry about getting the point and vertex mixed up it's been a while since I've done anything with gl and I wasn't trying to be accurate.
Last edited by Veggiet on May 05, 2007 16:32, edited 1 time in total.
Top
1000101
Posts: 2556
Joined: Jun 13, 2005 23:14
Location: SK, Canada

Post by 1000101 »

Ever hear of glutSphere?

glutSolidSphere ( radius As GLdouble, slices As GLint, stacks As GLint )
glutWireSphere ( radius As GLdouble, slices As GLint, stacks As GLint )

Besides, you need glvertex4f. Without it you wouldn't have very realistic 3d meshes.
Top
Post Reply

Return to “Projects”