Raytracing Code from Purearena

Just starting out? Need help? Post your questions and find answers here.
xxfreshman
User
User
Posts: 17
Joined: Mon Jun 13, 2016 8:22 pm

Raytracing Code from Purearena

Post by xxfreshman »

Please help me to get the following old Pure basic Code working. If I have a working version, I could start to translate it to Assembler. I want to show that most CPUs are fast enough to make the calculations itself. In 1998 Apple showed with IBM and Motorola a 640x480 Real-time Ray tracing of a Bathroom to Introduce the Power PC, hmm all Software. I need only one nice program, a than I could start to replace the calculations with assembler.

Thx

Code: Select all

; English forum: http://www.purebasic.fr/english/viewtopic.php?t=15568&postdays=0&postorder=asc&start=30
; Author: Dreglor (updated for PB 4.00 by Andre)
; Date: 23. June 2005
; OS: Windows
; Demo: Yes


;/Title: PBRay
;/Author: Dreglor
;/Date: 6-21-05
;/Version: Alpha
;/Function: Renders scenes using raytracing
;/Notes: Special Thanks to MrMat for helping me :)
;/Todo: fix bugs, phong lighting, shadows ,Refractions

;- Constants

#Version="Alpha"

#Tolerance=0.0001

#ObjectType_Null=0
#ObjectType_PointLight=1
#ObjectType_Sphere=2

#MaxChildren=3

#EPSILON=0.0001

;- Structures

Structure xyz
  x.f
  y.f
  z.f
EndStructure

Structure Matrix
  e11.f
  e12.f
  e13.f
  e21.f
  e22.f
  e23.f
  e31.f
  e32.f
  e33.f
EndStructure

Structure Camera
  Origin.xyz
  Direction.xyz
  ViewingAngle.xyz
EndStructure

Structure Color
  Red.f
  Green.f
  Blue.f
EndStructure

Structure Material
  SoildColor.Color
  Diffuse.f
  Reflect.f
  Refract.f
EndStructure

Structure PointLight
  Color.Color
  Origin.xyz
EndStructure

Structure Sphere
  radius.f
EndStructure

; Structure Plane ;incomplete
; normal.xyz
; Distance.xyz ;???
; EndStructure

; Structure Triangle ;incomplete
; v1.xyz
; v2.xyz
; v3.xyz
; normal.xyz
; EndStructure

Structure Object
  Type.b
  Material.Material
  Origin.xyz
  Direction.xyz
  IsLight.b
  Primitive.l ;points to a memory that get[primitive]structure will use to fill a structure with
EndStructure

Structure Scene
  Ambient.Color
  ScreenWidth.w
  ScreenHeight.w
  HalfScreenWidth.w
  HalfScreenHeight.w
EndStructure

;- Globals

Global MainScene.Scene

Global NewList ObjectList.Object()

;- Declares

Declare.l TestLoop();tester
Declare.b RenderScene(*Scene.Scene, *ViewPort.Camera)
Declare.l TraceRay(*Origin.xyz, *Direction.xyz, depth.b)
Declare.f TestSphere(*Origin.xyz, *Direction.xyz, *Sphere.Object)
Declare.l Shade(*Intersection.xyz,*Normal.xyz,*Direction.xyz,*Material.Material,depth.b)
Declare.b RemoveObject(objectHandle)
Declare.b AddSphereObject(*Sphere.Object,radius.f)
Declare.b GetObjectStructure(ObjectPointer,*destination.Object)
Declare.b SetObjectStructure(ObjectPointer,*source.Object)
Declare.b AddPointLightObject(*Light.PointLight)
Declare.w MatrixScalarDivision(*a.Matrix, Scalar.f,  *result.Matrix);divides a matrix to a scalar
Declare.w MatrixScalarMuiltply(*a.Matrix, Scalar.f,  *result.Matrix);muiltplies a matrix to a scalar
Declare.w MatrixSubtract(*a.Matrix,  *b.Matrix,  *result.Matrix);subtract 2 matrice together
Declare.w MatrixAdd(*a.Matrix,  *b.Matrix,  *result.Matrix);adds 2 matrice together
Declare.w MatrixInverse(*this.Matrix);returns the inverse of a matrix
Declare.w MatrixTranspose(*this.Matrix,  *result.Matrix);returns the transpose of a matrix
Declare.f MatrixDeterminant(*this.Matrix);returns the determiant of a matrix
Declare.f VectorTripleScalarProduct(*a.xyz,  *b.xyz,  *c.xyz);returns triple scalar product of 3 vectors
Declare.b VectorScalarDivide(*a.xyz, b.f,  *result.xyz);returns a pointer to a vector that has been divided
Declare.b VectorScalarMuilply(*a.xyz, b.f,  *result.xyz);returns a pointer to a vector that has been muiltiplied
Declare.b VectorSubtract(*a.xyz,  * b.xyz,  *result.xyz);returns a pointer to a vector that has been Subtracted
Declare.b VectorAdd(*a.xyz,  * b.xyz,  *result.xyz);returns a pointer to a vector that has been added
Declare.b VectorCrossMuiltply(*a.xyz,  *b.xyz,  *result.xyz);returns a pointer to a vector that has been crossed muiltiplied
Declare.b VectorReverse(*this.xyz);reverses a Vector
Declare.b VectorNormalize(*this.xyz);normilzes a vector
Declare.f VectorDotProduct(*a.xyz,  *b.xyz)
Declare.f VectorMagnitude(*this.xyz);returns the maginitude of a Vector
Declare.b ColorRangeCheck(*a.Color)
Declare.b ColorAdd(*a.Color,  *b.Color,  *result.Color);returns a pointer to a Color that has been added
Declare.b ColorMuilply(*a.Color,  *b.Color,  *result.Color);returns a pointer to a Color that has been muiltiplied
Declare.b ColorScalarMuilply(*a.Color, b.f,  *result.Color);returns a pointer to a Color that has been muiltiplied by a scalar


;- Procedures

;- Color Math

Procedure.b ColorScalarMuilply(*a.Color, b.f, *result.Color);returns a pointer to a Color that has been muiltiplied by a scalar
  *result\Red = *a\Red * b
  *result\Green = *a\Green * b
  *result\Blue = *a\Blue * b
EndProcedure

Procedure.b ColorMuilply(*a.Color, *b.Color, *result.Color);returns a pointer to a Color that has been muiltiplied
  *result\Red = *a\Red * *b\Red
  *result\Green = *a\Green * *b\Green
  *result\Blue = *a\Blue * *b\Blue
EndProcedure

Procedure.b ColorAdd(*a.Color, *b.Color, *result.Color);returns a pointer to a Color that has been added
  *result\Red = *a\Red + *b\Red
  *result\Green = *a\Green + *b\Green
  *result\Blue = *a\Blue + *b\Blue
EndProcedure

Procedure.b ColorRangeCheck(*a.Color)
  If *a\Red>1
    *a\Red=1
  EndIf
  If *a\Green>1
    *a\Green=1
  EndIf
  If *a\Blue>1
    *a\Blue=1
  EndIf
EndProcedure

;-Vector Math

Procedure.f VectorMagnitude(*this.xyz);returns the maginitude of a Vector
  ProcedureReturn Sqr((*this\x * *this\x)+(*this\y * *this\y)+(*this\z * *this\z))
EndProcedure

Procedure.f VectorDotProduct(*a.xyz, *b.xyz)
  ProcedureReturn *a\x * *b\x + *a\y * *b\y + *a\z * *b\z
EndProcedure

Procedure.b VectorNormalize(*this.xyz);normilzes a vector
  m.f = Sqr(*this\x * *this\x + *this\y * *this\y + *this\z * *this\z)
  If m > #Tolerance
    *this\x = *this\x / m
    *this\y = *this\y / m
    *this\z = *this\z / m
  EndIf
  If  Abs(*this\x) < #Tolerance
    *this\x = 0
  EndIf
  If  Abs(*this\y) < #Tolerance
    *this\y = 0
  EndIf
  If  Abs(*this\z) < #Tolerance
    *this\z = 0
  EndIf
EndProcedure

Procedure.b VectorReverse(*this.xyz);reverses a Vector
  *this\x = -*this\x
  *this\y = -*this\y
  *this\z = -*this\z
EndProcedure

Procedure.b VectorCrossMuiltply(*a.xyz, *b.xyz, *result.xyz);returns a pointer to a vector that has been crossed muiltiplied
  *result\x = *a\y * *b\z - *a\z * *b\y
  *result\y = -*a\x * *b\z + *a\z * *b\x
  *result\z = *a\x * *b\y - *a\y * *b\x
EndProcedure

Procedure.b VectorAdd(*a.xyz, *b.xyz, *result.xyz);returns a pointer to a vector that has been added
  *result\x = *a\x + *b\x
  *result\y = *a\y + *b\y
  *result\z = *a\z + *b\z
EndProcedure

Procedure.b VectorSubtract(*a.xyz, *b.xyz, *result.xyz);returns a pointer to a vector that has been Subtracted
  *result\x = *a\x - *b\x
  *result\y = *a\y - *b\y
  *result\z = *a\z - *b\z
EndProcedure

Procedure.b VectorScalarMuilply(*a.xyz, b.f, *result.xyz);returns a pointer to a vector that has been muiltiplied
  *result\x = *a\x * b
  *result\y = *a\y * b
  *result\z = *a\z * b
EndProcedure

Procedure.b VectorScalarDivide(*a.xyz, b.f, *result.xyz);returns a pointer to a vector that has been divided
  *result\x = *a\x / b
  *result\y = *a\y / b
  *result\z = *a\z / b
EndProcedure

Procedure.f VectorTripleScalarProduct(*a.xyz, *b.xyz, *c.xyz);returns triple scalar product of 3 vectors
  ProcedureReturn  *a\x * (*b\y * *c\z - *b\z * *c\y)+(*a\y * (-*b\x * *c\z + *b\z * *c\x))+(*a\z * (*b\x * *c\y - *b\y * *c\x))
EndProcedure

;-Matrix Math


Procedure.f MatrixDeterminant(*this.Matrix);returns the determiant of a matrix
  ProcedureReturn  *this\e11 * *this\e22 * *this\e33 - *this\e11 * *this\e32 * *this\e23 + *this\e21 * *this\e32 * *this\e13 - *this\e21 * *this\e12 * *this\e33 + *this\e31 * *this\e12 * *this\e23 - *this\e31 * *this\e22 * *this\e13
EndProcedure

Procedure.w MatrixTranspose(*this.Matrix, *result.Matrix);returns the transpose of a matrix
  *result\e11 = *this\e11
  *result\e21 = *this\e12
  *result\e31 = *this\e13
  *result\e12 = *this\e21
  *result\e22 = *this\e22
  *result\e32 = *this\e23
  *result\e13 = *this\e31
  *result\e23 = *this\e32
  *result\e33 = *this\e33
EndProcedure

Procedure.w MatrixInverse(*this.Matrix);returns the inverse of a matrix
  d.f  = MatrixDeterminant(*this)
  If d  = 0
    d  = 1
  EndIf
  *this\e11 =  (*this\e22  *  *this\e33  -  *this\e23  *  *this\e32)/d
  *this\e21 = -(*this\e12  *  *this\e33  -  *this\e13  *  *this\e32)/d
  *this\e31 =  (*this\e12  *  *this\e23  -  *this\e13  *  *this\e22)/d
  *this\e12 = -(*this\e21  *  *this\e33  -  *this\e23  *  *this\e31)/d
  *this\e22 =  (*this\e11  *  *this\e33  -  *this\e13  *  *this\e31)/d
  *this\e32 = -(*this\e11  *  *this\e23  -  *this\e13  *  *this\e21)/d
  *this\e13 =  (*this\e21  *  *this\e32  -  *this\e12  *  *this\e31)/d
  *this\e23 = -(*this\e11  *  *this\e32  -  *this\e12  *  *this\e31)/d
  *this\e33 =  (*this\e11  *  *this\e22  -  *this\e12  *  *this\e21)/d
EndProcedure

Procedure.w MatrixAdd(*a.Matrix, *b.Matrix, *result.Matrix);adds 2 matrice together
  *result\e11 = *a\e11 + *b\e11
  *result\e12 = *a\e12 + *b\e12
  *result\e13 = *a\e13 + *b\e13
  *result\e21 = *a\e21 + *b\e21
  *result\e22 = *a\e22 + *b\e22
  *result\e23 = *a\e23 + *b\e23
  *result\e31 = *a\e31 + *b\e31
  *result\e32 = *a\e32 + *b\e32
  *result\e33 = *a\e33 + *b\e33
EndProcedure

Procedure.w MatrixSubtract(*a.Matrix, *b.Matrix, *result.Matrix);subtract 2 matrice together
  *result\e11 = *a\e11 - *b\e11
  *result\e12 = *a\e12 - *b\e12
  *result\e13 = *a\e13 - *b\e13
  *result\e21 = *a\e21 - *b\e21
  *result\e22 = *a\e22 - *b\e22
  *result\e23 = *a\e23 - *b\e23
  *result\e31 = *a\e31 - *b\e31
  *result\e32 = *a\e32 - *b\e32
  *result\e33 = *a\e33 - *b\e33
EndProcedure

Procedure.w MatrixScalarMuiltply(*a.Matrix, Scalar.f, *result.Matrix);muiltplies a matrix to a scalar
  *result\e11 = *a\e11 * Scalar
  *result\e12 = *a\e12 * Scalar
  *result\e13 = *a\e13 * Scalar
  *result\e21 = *a\e21 * Scalar
  *result\e22 = *a\e22 * Scalar
  *result\e23 = *a\e23 * Scalar
  *result\e31 = *a\e31 * Scalar
  *result\e32 = *a\e32 * Scalar
  *result\e33 = *a\e33 * Scalar
EndProcedure

Procedure.w MatrixScalarDivision(*a.Matrix, Scalar.f, *result.Matrix);divides a matrix to a scalar
  *result\e11 = *a\e11 / Scalar
  *result\e12 = *a\e12 / Scalar
  *result\e13 = *a\e13 / Scalar
  *result\e21 = *a\e21 / Scalar
  *result\e22 = *a\e22 / Scalar
  *result\e23 = *a\e23 / Scalar
  *result\e31 = *a\e31 / Scalar
  *result\e32 = *a\e32 / Scalar
  *result\e33 = *a\e33 / Scalar
EndProcedure

;-FrameWork

Procedure.b AddPointLightObject(*Light.PointLight)
  If CountList(ObjectList())>0
    *Old_Element = @ObjectList()
  EndIf
  AddElement(ObjectList())
  ObjectList()\Type=#ObjectType_PointLight
  ObjectList()\Material\SoildColor\Red=*Light\Color\Red
  ObjectList()\Material\SoildColor\Green=*Light\Color\Green
  ObjectList()\Material\SoildColor\Blue=*Light\Color\Blue
  ObjectList()\Origin\x=*Light\Origin\x
  ObjectList()\Origin\y=*Light\Origin\y
  ObjectList()\Origin\z=*Light\Origin\z
  ObjectList()\IsLight=#True
  ObjectList()\Primitive=#Null
  result.l=@ObjectList()
  If *Old_Element<>#Null
    ChangeCurrentElement(ObjectList(), *Old_Element)
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.b AddSphereObject(*Sphere.Object,radius.f)
  If CountList(ObjectList())>0
    *Old_Element = @ObjectList()
  EndIf
  AddElement(ObjectList())
  ;copy object data into the new object
  CopyMemory(*Sphere,@ObjectList(),SizeOf(Object))
  ;put any primtive specific data into there places
  ObjectList()\Primitive=AllocateMemory(4)
  PokeF(ObjectList()\Primitive,radius)
  ObjectList()\Type=#ObjectType_Sphere
  result.l=@ObjectList()
  If *Old_Element<>#Null
    ChangeCurrentElement(ObjectList(), *Old_Element)
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.b GetObjectStructure(ObjectPointer,*destination.Object)
  If CountList(ObjectList())>0
    *Old_Element = @ObjectList()
  EndIf
  ChangeCurrentElement(ObjectList(), ObjectPointer)
  ;copy object data into the new object
  CopyMemory(@ObjectList(),*destination,SizeOf(Object))
  If *Old_Element<>#Null
    ChangeCurrentElement(ObjectList(), *Old_Element)
  EndIf
EndProcedure

Procedure.b SetObjectStructure(ObjectPointer,*source.Object)
  If CountList(ObjectList())>0
    *Old_Element = @ObjectList()
  EndIf
  ChangeCurrentElement(ObjectList(), ObjectPointer)
  ;copy object data into the new object
  CopyMemory(*source,@ObjectList(),SizeOf(Object))
  If *Old_Element<>#Null
    ChangeCurrentElement(ObjectList(), *Old_Element)
  EndIf
EndProcedure

Procedure.b RemoveObject(ObjectPointer)
  If CountList(ObjectList())>0
    *Old_Element = @ObjectList()
  EndIf
  ChangeCurrentElement(ObjectList(), ObjectPointer)
  If ObjectList()\Primitive<>#Null
    FreeMemory(ObjectList()\Primitive)
  EndIf
  DeleteElement(ObjectList())
  If CountList(ObjectList())>0 And *Old_Element<>#Null
    ChangeCurrentElement(ObjectList(), *Old_Element)
  EndIf
EndProcedure

Procedure.l Shade(*Intersection.xyz,*Normal.xyz,*Direction.xyz,*Material.Material,depth.b)
  *Old_Element=@ObjectList()
  *result.Color
  Color.Color
  Light.xyz
  Relfection.xyz
  *reflectcolor.Color
  ReflectOrigin.xyz
  Accumalated.Color
  tempvec.xyz
  ResetList(ObjectList())
  For Object=0 To CountList(ObjectList()) - 1
    NextElement(ObjectList())
    If ObjectList()\IsLight=#True
      VectorSubtract(ObjectList()\Origin,*Intersection,Light) ;Origin - Intersection;
      VectorNormalize(Light)
      If *Material\Diffuse > 0
        dot.f=VectorDotProduct(*Normal,Light)
        If dot>0
          diff.f=dot * *Material\Diffuse
          ColorMuilply(*Material\SoildColor,ObjectList()\Material\SoildColor,Color) ;Accumalated += diff * MaterialColor * LightColor
          ColorScalarMuilply(Color,diff,Color)
          ColorAdd(Color,Accumalated,Accumalated)
        EndIf
        If *Material\Reflect>0
          r.f=2*VectorDotProduct(*Direction,*Normal)
          VectorScalarMuilply(*Normal,r,tempvec)
          VectorSubtract(*Direction,tempvec,Relfection);Direction - 2 * DOT( Direction, normal ) * normal
          VectorScalarMuilply(Relfection,#EPSILON,ReflectOrigin)
          VectorAdd(*Intersection,ReflectOrigin,ReflectOrigin);Intersection+Reflection*EPSILON
          *reflectcolor=TraceRay(ReflectOrigin,Relfection,depth+1)
          ColorScalarMuilply(*reflectcolor,*Material\Reflect,Color)
          ColorMuilply(Color,*Material\SoildColor,Color)
          ColorAdd(Color,Accumalated,Accumalated);Accumalated += MaterialReflect * reflectcolor * MaterialColor
        EndIf
      EndIf
    EndIf
  Next Object
  ColorRangeCheck(Accumalated)
  ChangeCurrentElement(ObjectList(), *Old_Element)
  ProcedureReturn @Accumalated
EndProcedure

Procedure.f TestSphere(*Origin.xyz,*Direction.xyz,*Sphere.Object)
  offset.xyz
  VectorSubtract(*Origin, *Sphere\Origin, offset)

  radius.f = PeekF(*Sphere\Primitive)

  b.f = 2 * (*Direction\x * offset\x + *Direction\y * offset\y + *Direction\z * offset\z)
  c.f = offset\x * offset\x + offset\y * offset\y + offset\z * offset\z - radius * radius
  d.f = b * b - 4 * c

  If d > 0 ;hit the sphere
    t.f = (-b - Sqr(d)) * 0.5 ; Could return +ve or -ve number!
  EndIf

  ProcedureReturn t
EndProcedure

Procedure TraceRay(*Origin.xyz,*Direction.xyz,depth.b)
  Intersection.xyz
  Normal.xyz
  *Old_Element=@ObjectList()
  *result.Color
  If depth<#MaxChildren
    Closesthandle=-1
    ClosestT.f=-1
    ResetList(ObjectList())
    For Object=0 To CountList(ObjectList()) - 1
      NextElement(ObjectList())
      Select ObjectList()\Type
        Case #ObjectType_Sphere
          t.f=TestSphere(*Origin,*Direction,@ObjectList())
          If t>0
            If t<ClosestT Or ClosestT=-1
              Closesthandle=Object
              ClosestT=t
            EndIf
          EndIf
          ;other cases will be added
      EndSelect
    Next Object
    If ClosestT>0
      t=ClosestT
      SelectElement(ObjectList(),Closesthandle)
      VectorScalarMuilply(*Direction,t,Intersection) ;Calulate Interesction point with
      VectorAdd(*Origin,Intersection,Intersection) ;Origin + Direction * T;
      If ObjectList()\Type=#ObjectType_Sphere ;normal Calulations are diffrent per object
        VectorSubtract(Intersection ,ObjectList()\Origin,Normal)
        VectorScalarDivide(Normal,PeekF(ObjectList()\Primitive),Normal)
        ;other cases will be added
      EndIf
      *result = Shade(Intersection,Normal,*Direction,ObjectList()\Material,depth)
    EndIf
  EndIf
  ChangeCurrentElement(ObjectList(), *Old_Element)
  If *result=0
    Black.Color
    Black\Red=0
    Black\Green=0
    Black\Blue=0
    *result=@Black
    ProcedureReturn *result
  Else
    ProcedureReturn *result
  EndIf
EndProcedure

Procedure.b RenderScene(*Scene.Scene,*ViewPort.Camera)
  *Color.Color
  For y = -*Scene\HalfScreenHeight To *Scene\HalfScreenHeight - 1
    For x = -*Scene\HalfScreenWidth To *Scene\HalfScreenWidth - 1
      *ViewPort\Direction\x = x
      *ViewPort\Direction\y = y
      *ViewPort\Direction\z = 0
      VectorSubtract(*ViewPort\Direction,*ViewPort\Origin,*ViewPort\Direction)
      VectorNormalize(*ViewPort\Direction)
      *Color=TraceRay(*ViewPort\Origin,*ViewPort\Direction,0)
      If *Color<>0 Or *Color\Red<>0 Or *Color\Green<>0 Or *Color\Blue<>0
        Plot(*Scene\HalfScreenWidth + x, *Scene\HalfScreenHeight + y,RGB(*Color\Red*255,*Color\Green*255,*Color\Blue*255))
      EndIf
    Next x
  Next y
EndProcedure

Procedure TestLoop() ;tester
  Sphere1.Object
  Sphere1Radius.f
  Sphere2.Object
  Sphere2Radius.f
  Light1.PointLight
  light2.PointLight
  MainCamera.Camera
  MainScene.Scene

  Sphere1\Origin\x=-150
  Sphere1\Origin\y=0
  Sphere1\Origin\z=200
  Sphere1\Material\SoildColor\Red=0.25
  Sphere1\Material\SoildColor\Green=0.25
  Sphere1\Material\SoildColor\Blue=0.25
  Sphere1\Material\Diffuse=1
  Sphere1\Material\Reflect=0
  Sphere1\Material\Refract=0
  Sphere1Radius=150

  AddSphereObject(Sphere1,Sphere1Radius)

  Sphere2\Origin\x=150
  Sphere2\Origin\y=0
  Sphere2\Origin\z=100
  Sphere2\Material\SoildColor\Red=0
  Sphere2\Material\SoildColor\Green=0
  Sphere2\Material\SoildColor\Blue=0.25
  Sphere2\Material\Diffuse=1
  Sphere2\Material\Reflect=0
  Sphere2\Material\Refract=0
  Sphere2Radius=100

  AddSphereObject(Sphere2,Sphere2Radius)

  Light1\Origin\x=-20
  Light1\Origin\y=50
  Light1\Origin\z=50
  Light1\Color\Red=1
  Light1\Color\Green=1
  Light1\Color\Blue=1

  AddPointLightObject(Light1)

  light2\Origin\x=20
  light2\Origin\y=-50
  light2\Origin\z=-50
  light2\Color\Red=1
  light2\Color\Green=1
  light2\Color\Blue=1

  AddPointLightObject(light2)

  MainCamera\Origin\x=0
  MainCamera\Origin\y=0
  MainCamera\Origin\z=-256
  MainCamera\ViewingAngle\x=0
  MainCamera\ViewingAngle\y=0
  MainCamera\ViewingAngle\z=0

  ; MainScene\Ambient\Red=0.125
  ; MainScene\Ambient\Green=0.125 ;not active
  ; MainScene\Ambient\Blue=0.125
  MainScene\ScreenWidth=320
  MainScene\ScreenHeight=240
  MainScene\HalfScreenWidth=MainScene\ScreenWidth/2
  MainScene\HalfScreenHeight=MainScene\ScreenHeight/2

  InitSprite()
  OpenWindow(0,0,0,MainScene\ScreenWidth,MainScene\ScreenHeight,"PBRay - FPS: 0",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  OpenWindowedScreen(WindowID(0),0,0,MainScene\ScreenWidth,MainScene\ScreenHeight,0,0,0)


  Repeat
    frame+1
    start=ElapsedMilliseconds()

    ClearScreen(RGB(0, 0, 0))
    StartDrawing(ScreenOutput())

    RenderScene(MainScene,MainCamera)

    StopDrawing()
    FlipBuffers(0)
    stop=ElapsedMilliseconds()
    ;    CallDebugger
    If (stop-start2)>=1000
      start2=ElapsedMilliseconds()
      fps=frame
      frame=0
    EndIf
    SetWindowTitle(0,"PBRay - FPS: "+Str(fps)+" RenderTime: "+Str(stop-start))
  Until WindowEvent() = #PB_Event_CloseWindow
EndProcedure

TestLoop()

; IDE Options = PureBasic v4.02 (Windows - x86)
; Folding = ------
; DisableDebugger
User avatar
idle
Always Here
Always Here
Posts: 5836
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Raytracing Code from Purearena

Post by idle »

not sure if this is right compile without debugger

Code: Select all

; English forum: http://www.purebasic.fr/english/viewtopic.php?t=15568&postdays=0&postorder=asc&start=30
; Author: Dreglor (updated for PB 4.00 by Andre)
; Date: 23. June 2005
; OS: Windows
; Demo: Yes


;/Title: PBRay
;/Author: Dreglor
;/Date: 6-21-05
;/Version: Alpha
;/Function: Renders scenes using raytracing
;/Notes: Special Thanks to MrMat for helping me :)
;/Todo: fix bugs, phong lighting, shadows ,Refractions

;- Constants

#Version="Alpha"

#Tolerance=0.0001

#ObjectType_Null=0
#ObjectType_PointLight=1
#ObjectType_Sphere=2

#MaxChildren=3

#EPSILON=0.0001

;- Structures

Structure xyz
  x.f
  y.f
  z.f
EndStructure

Structure Matrix
  e11.f
  e12.f
  e13.f
  e21.f
  e22.f
  e23.f
  e31.f
  e32.f
  e33.f
EndStructure

Structure Camera
  Origin.xyz
  Direction.xyz
  ViewingAngle.xyz
EndStructure

Structure Color
  Red.f
  Green.f
  Blue.f
EndStructure

Structure Material
  SoildColor.Color
  Diffuse.f
  Reflect.f
  Refract.f
EndStructure

Structure PointLight
  Color.Color
  Origin.xyz
EndStructure

Structure Sphere
  radius.f
EndStructure

; Structure Plane ;incomplete
; normal.xyz
; Distance.xyz ;???
; EndStructure

; Structure Triangle ;incomplete
; v1.xyz
; v2.xyz
; v3.xyz
; normal.xyz
; EndStructure

Structure Object
  Type.b
  Material.Material
  Origin.xyz
  Direction.xyz
  IsLight.b
  Primitive.i ;points to a memory that get[primitive]structure will use to fill a structure with
EndStructure

Structure Scene
  Ambient.Color
  ScreenWidth.w
  ScreenHeight.w
  HalfScreenWidth.w
  HalfScreenHeight.w
EndStructure

;- Globals

Global MainScene.Scene

Global NewList ObjectList.Object()

;- Declares

Declare.i TestLoop();tester
Declare.b RenderScene(*Scene.Scene, *ViewPort.Camera)
Declare.i TraceRay(*Origin.xyz, *Direction.xyz, depth.b) 
Declare.f TestSphere(*Origin.xyz, *Direction.xyz, *Sphere.Object)
Declare.i Shade(*Intersection.xyz,*Normal.xyz,*Direction.xyz,*Material.Material,depth.b)
Declare.b RemoveObject(objectHandle)
Declare.b AddSphereObject(*Sphere.Object,radius.f)
Declare.b GetObjectStructure(ObjectPointer,*destination.Object)
Declare.b SetObjectStructure(ObjectPointer,*source.Object)
Declare.b AddPointLightObject(*Light.PointLight)
Declare.w MatrixScalarDivision(*a.Matrix, Scalar.f,  *result.Matrix);divides a matrix to a scalar
Declare.w MatrixScalarMuiltply(*a.Matrix, Scalar.f,  *result.Matrix);muiltplies a matrix to a scalar
Declare.w MatrixSubtract(*a.Matrix,  *b.Matrix,  *result.Matrix);subtract 2 matrice together
Declare.w MatrixAdd(*a.Matrix,  *b.Matrix,  *result.Matrix);adds 2 matrice together
Declare.w MatrixInverse(*this.Matrix);returns the inverse of a matrix
Declare.w MatrixTranspose(*this.Matrix,  *result.Matrix);returns the transpose of a matrix
Declare.f MatrixDeterminant(*this.Matrix);returns the determiant of a matrix
Declare.f VectorTripleScalarProduct(*a.xyz,  *b.xyz,  *c.xyz);returns triple scalar product of 3 vectors
Declare.b VectorScalarDivide(*a.xyz, b.f,  *result.xyz);returns a pointer to a vector that has been divided
Declare.b VectorScalarMuilply(*a.xyz, b.f,  *result.xyz);returns a pointer to a vector that has been muiltiplied
Declare.b VectorSubtract(*a.xyz,  *b.xyz,  *result.xyz);returns a pointer to a vector that has been Subtracted
Declare.b VectorAdd(*a.xyz,  *b.xyz,  *result.xyz);returns a pointer to a vector that has been added
Declare.b VectorCrossMuiltply(*a.xyz,  *b.xyz,  *result.xyz);returns a pointer to a vector that has been crossed muiltiplied
Declare.b VectorReverse(*this.xyz);reverses a Vector
Declare.b VectorNormalize(*this.xyz);normilzes a vector
Declare.f VectorDotProduct(*a.xyz,  *b.xyz)
Declare.f VectorMagnitude(*this.xyz);returns the maginitude of a Vector
Declare.b ColorRangeCheck(*a.Color)
Declare.b ColorAdd(*a.Color,  *b.Color,  *result.Color);returns a pointer to a Color that has been added
Declare.b ColorMuilply(*a.Color,  *b.Color,  *result.Color);returns a pointer to a Color that has been muiltiplied
Declare.b ColorScalarMuilply(*a.Color, b.f,  *result.Color);returns a pointer to a Color that has been muiltiplied by a scalar


;- Procedures

;- Color Math

Procedure.b ColorScalarMuilply(*a.Color, b.f, *result.Color);returns a pointer to a Color that has been muiltiplied by a scalar
  *result\Red = *a\Red * b
  *result\Green = *a\Green * b
  *result\Blue = *a\Blue * b
EndProcedure

Procedure.b ColorMuilply(*a.Color, *b.Color, *result.Color);returns a pointer to a Color that has been muiltiplied
  *result\Red = *a\Red * *b\Red
  *result\Green = *a\Green * *b\Green
  *result\Blue = *a\Blue * *b\Blue
EndProcedure

Procedure.b ColorAdd(*a.Color, *b.Color, *result.Color);returns a pointer to a Color that has been added
  *result\Red = *a\Red + *b\Red
  *result\Green = *a\Green + *b\Green
  *result\Blue = *a\Blue + *b\Blue
EndProcedure

Procedure.b ColorRangeCheck(*a.Color)
  If *a\Red>1
    *a\Red=1
  EndIf
  If *a\Green>1
    *a\Green=1
  EndIf
  If *a\Blue>1
    *a\Blue=1
  EndIf
EndProcedure

;-Vector Math

Procedure.f VectorMagnitude(*this.xyz);returns the maginitude of a Vector
  ProcedureReturn Sqr((*this\x * *this\x)+(*this\y * *this\y)+(*this\z * *this\z))
EndProcedure

Procedure.f VectorDotProduct(*a.xyz, *b.xyz)
  ProcedureReturn *a\x * *b\x + *a\y * *b\y + *a\z * *b\z
EndProcedure

Procedure.b VectorNormalize(*this.xyz);normilzes a vector
  m.f = Sqr(*this\x * *this\x + *this\y * *this\y + *this\z * *this\z)
  If m > #Tolerance
    *this\x = *this\x / m
    *this\y = *this\y / m
    *this\z = *this\z / m
  EndIf
  If  Abs(*this\x) < #Tolerance
    *this\x = 0
  EndIf
  If  Abs(*this\y) < #Tolerance
    *this\y = 0
  EndIf
  If  Abs(*this\z) < #Tolerance
    *this\z = 0
  EndIf
EndProcedure

Procedure.b VectorReverse(*this.xyz);reverses a Vector
  *this\x = -*this\x
  *this\y = -*this\y
  *this\z = -*this\z
EndProcedure

Procedure.b VectorCrossMuiltply(*a.xyz, *b.xyz, *result.xyz);returns a pointer to a vector that has been crossed muiltiplied
  *result\x = *a\y * *b\z - *a\z * *b\y
  *result\y = -*a\x * *b\z + *a\z * *b\x
  *result\z = *a\x * *b\y - *a\y * *b\x
EndProcedure

Procedure.b VectorAdd(*a.xyz, *b.xyz, *result.xyz);returns a pointer to a vector that has been added
  *result\x = *a\x + *b\x
  *result\y = *a\y + *b\y
  *result\z = *a\z + *b\z
EndProcedure

Procedure.b VectorSubtract(*a.xyz, *b.xyz, *result.xyz);returns a pointer to a vector that has been Subtracted
  *result\x = *a\x - *b\x
  *result\y = *a\y - *b\y
  *result\z = *a\z - *b\z
EndProcedure

Procedure.b VectorScalarMuilply(*a.xyz, b.f, *result.xyz);returns a pointer to a vector that has been muiltiplied
  *result\x = *a\x * b
  *result\y = *a\y * b
  *result\z = *a\z * b
EndProcedure

Procedure.b VectorScalarDivide(*a.xyz, b.f, *result.xyz);returns a pointer to a vector that has been divided
  *result\x = *a\x / b
  *result\y = *a\y / b
  *result\z = *a\z / b
EndProcedure

Procedure.f VectorTripleScalarProduct(*a.xyz, *b.xyz, *c.xyz);returns triple scalar product of 3 vectors
  ProcedureReturn  *a\x * (*b\y * *c\z - *b\z * *c\y)+(*a\y * (-*b\x * *c\z + *b\z * *c\x))+(*a\z * (*b\x * *c\y - *b\y * *c\x))
EndProcedure

;-Matrix Math


Procedure.f MatrixDeterminant(*this.Matrix);returns the determiant of a matrix
  ProcedureReturn  *this\e11 * *this\e22 * *this\e33 - *this\e11 * *this\e32 * *this\e23 + *this\e21 * *this\e32 * *this\e13 - *this\e21 * *this\e12 * *this\e33 + *this\e31 * *this\e12 * *this\e23 - *this\e31 * *this\e22 * *this\e13
EndProcedure

Procedure.w MatrixTranspose(*this.Matrix, *result.Matrix);returns the transpose of a matrix
  *result\e11 = *this\e11
  *result\e21 = *this\e12
  *result\e31 = *this\e13
  *result\e12 = *this\e21
  *result\e22 = *this\e22
  *result\e32 = *this\e23
  *result\e13 = *this\e31
  *result\e23 = *this\e32
  *result\e33 = *this\e33
EndProcedure

Procedure.w MatrixInverse(*this.Matrix);returns the inverse of a matrix
  d.f  = MatrixDeterminant(*this)
  If d  = 0
    d  = 1
  EndIf
  *this\e11 =  (*this\e22  *  *this\e33  -  *this\e23  *  *this\e32)/d
  *this\e21 = -(*this\e12  *  *this\e33  -  *this\e13  *  *this\e32)/d
  *this\e31 =  (*this\e12  *  *this\e23  -  *this\e13  *  *this\e22)/d
  *this\e12 = -(*this\e21  *  *this\e33  -  *this\e23  *  *this\e31)/d
  *this\e22 =  (*this\e11  *  *this\e33  -  *this\e13  *  *this\e31)/d
  *this\e32 = -(*this\e11  *  *this\e23  -  *this\e13  *  *this\e21)/d
  *this\e13 =  (*this\e21  *  *this\e32  -  *this\e12  *  *this\e31)/d
  *this\e23 = -(*this\e11  *  *this\e32  -  *this\e12  *  *this\e31)/d
  *this\e33 =  (*this\e11  *  *this\e22  -  *this\e12  *  *this\e21)/d
EndProcedure

Procedure.w MatrixAdd(*a.Matrix, *b.Matrix, *result.Matrix);adds 2 matrice together
  *result\e11 = *a\e11 + *b\e11
  *result\e12 = *a\e12 + *b\e12
  *result\e13 = *a\e13 + *b\e13
  *result\e21 = *a\e21 + *b\e21
  *result\e22 = *a\e22 + *b\e22
  *result\e23 = *a\e23 + *b\e23
  *result\e31 = *a\e31 + *b\e31
  *result\e32 = *a\e32 + *b\e32
  *result\e33 = *a\e33 + *b\e33
EndProcedure

Procedure.w MatrixSubtract(*a.Matrix, *b.Matrix, *result.Matrix);subtract 2 matrice together
  *result\e11 = *a\e11 - *b\e11
  *result\e12 = *a\e12 - *b\e12
  *result\e13 = *a\e13 - *b\e13
  *result\e21 = *a\e21 - *b\e21
  *result\e22 = *a\e22 - *b\e22
  *result\e23 = *a\e23 - *b\e23
  *result\e31 = *a\e31 - *b\e31
  *result\e32 = *a\e32 - *b\e32
  *result\e33 = *a\e33 - *b\e33
EndProcedure

Procedure.w MatrixScalarMuiltply(*a.Matrix, Scalar.f, *result.Matrix);muiltplies a matrix to a scalar
  *result\e11 = *a\e11 * Scalar
  *result\e12 = *a\e12 * Scalar
  *result\e13 = *a\e13 * Scalar
  *result\e21 = *a\e21 * Scalar
  *result\e22 = *a\e22 * Scalar
  *result\e23 = *a\e23 * Scalar
  *result\e31 = *a\e31 * Scalar
  *result\e32 = *a\e32 * Scalar
  *result\e33 = *a\e33 * Scalar
EndProcedure

Procedure.w MatrixScalarDivision(*a.Matrix, Scalar.f, *result.Matrix);divides a matrix to a scalar
  *result\e11 = *a\e11 / Scalar
  *result\e12 = *a\e12 / Scalar
  *result\e13 = *a\e13 / Scalar
  *result\e21 = *a\e21 / Scalar
  *result\e22 = *a\e22 / Scalar
  *result\e23 = *a\e23 / Scalar
  *result\e31 = *a\e31 / Scalar
  *result\e32 = *a\e32 / Scalar
  *result\e33 = *a\e33 / Scalar
EndProcedure

;-FrameWork

Procedure.b AddPointLightObject(*Light.PointLight)
  If ListSize(ObjectList())>0
    *Old_Element = @ObjectList()
  EndIf
  AddElement(ObjectList())
  ObjectList()\Type=#ObjectType_PointLight
  ObjectList()\Material\SoildColor\Red=*Light\Color\Red
  ObjectList()\Material\SoildColor\Green=*Light\Color\Green
  ObjectList()\Material\SoildColor\Blue=*Light\Color\Blue
  ObjectList()\Origin\x=*Light\Origin\x
  ObjectList()\Origin\y=*Light\Origin\y
  ObjectList()\Origin\z=*Light\Origin\z
  ObjectList()\IsLight=#True
  ObjectList()\Primitive=#Null
  result.l=@ObjectList()
  If *Old_Element<>#Null
    ChangeCurrentElement(ObjectList(), *Old_Element)
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.b AddSphereObject(*Sphere.Object,radius.f)
  If ListSize(ObjectList())>0
    *Old_Element = @ObjectList()
  EndIf
  AddElement(ObjectList())
  ;copy object data into the new object
  CopyMemory(*Sphere,@ObjectList(),SizeOf(Object))
  ;put any primtive specific data into there places
  ObjectList()\Primitive=AllocateMemory(4)
  PokeF(@ObjectList()\Primitive,radius)
  ObjectList()\Type=#ObjectType_Sphere
  result.l=@ObjectList()
  If *Old_Element<>#Null
    ChangeCurrentElement(ObjectList(), *Old_Element)
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.b GetObjectStructure(ObjectPointer,*destination.Object)
  If ListSize(ObjectList())>0
    *Old_Element = @ObjectList()
  EndIf
  ChangeCurrentElement(ObjectList(), ObjectPointer)
  ;copy object data into the new object
  CopyMemory(@ObjectList(),*destination,SizeOf(Object))
  If *Old_Element<>#Null
    ChangeCurrentElement(ObjectList(), *Old_Element)
  EndIf
EndProcedure

Procedure.b SetObjectStructure(ObjectPointer,*source.Object)
  If ListSize(ObjectList())>0
    *Old_Element = @ObjectList()
  EndIf
  ChangeCurrentElement(ObjectList(), ObjectPointer)
  ;copy object data into the new object
  CopyMemory(*source,@ObjectList(),SizeOf(Object))
  If *Old_Element<>#Null
    ChangeCurrentElement(ObjectList(), *Old_Element)
  EndIf
EndProcedure

Procedure.b RemoveObject(ObjectPointer)
  If ListSize(ObjectList())>0
    *Old_Element = @ObjectList()
  EndIf
  ChangeCurrentElement(ObjectList(), ObjectPointer)
  If ObjectList()\Primitive<>#Null
    FreeMemory(ObjectList()\Primitive)
  EndIf
  DeleteElement(ObjectList())
  If ListSize(ObjectList())>0 And *Old_Element<>#Null
    ChangeCurrentElement(ObjectList(), *Old_Element)
  EndIf
EndProcedure

Procedure.i Shade(*Intersection.xyz,*Normal.xyz,*Direction.xyz,*Material.Material,depth.b)
  *Old_Element=@ObjectList()
  *result.Color
  Color.Color
  Light.xyz
  Relfection.xyz
  *reflectcolor.Color
  ReflectOrigin.xyz
  Accumalated.Color
  tempvec.xyz
  ResetList(ObjectList())
  For Object=0 To ListSize(ObjectList()) - 1
    NextElement(ObjectList())
    If ObjectList()\IsLight=#True
      VectorSubtract(@ObjectList()\Origin,*Intersection,Light) ;Origin - Intersection;
      VectorNormalize(Light)
      If *Material\Diffuse > 0
        dot.f=VectorDotProduct(*Normal,Light)
        If dot>0
          diff.f=dot * *Material\Diffuse
          ColorMuilply(*Material\SoildColor,ObjectList()\Material\SoildColor,Color) ;Accumalated += diff * MaterialColor * LightColor
          ColorScalarMuilply(Color,diff,Color)
          ColorAdd(Color,Accumalated,Accumalated)
        EndIf
        If *Material\Reflect>0
          r.f=2*VectorDotProduct(*Direction,*Normal)
          VectorScalarMuilply(*Normal,r,tempvec)
          VectorSubtract(*Direction,tempvec,Relfection);Direction - 2 * DOT( Direction, normal ) * normal
          VectorScalarMuilply(Relfection,#EPSILON,ReflectOrigin)
          VectorAdd(*Intersection,ReflectOrigin,ReflectOrigin);Intersection+Reflection*EPSILON
          *reflectcolor=TraceRay(ReflectOrigin,Relfection,depth+1)
          ColorScalarMuilply(*reflectcolor,*Material\Reflect,Color)
          ColorMuilply(Color,*Material\SoildColor,Color)
          ColorAdd(Color,Accumalated,Accumalated);Accumalated += MaterialReflect * reflectcolor * MaterialColor
        EndIf
      EndIf
    EndIf
  Next Object
  ColorRangeCheck(Accumalated)
  ChangeCurrentElement(ObjectList(), *Old_Element)
  ProcedureReturn Accumalated
EndProcedure

Procedure.f TestSphere(*Origin.xyz,*Direction.xyz,*Sphere.Object)
  offset.xyz
  VectorSubtract(*Origin, *Sphere\Origin, offset)

  radius.f = PeekF(@*Sphere\Primitive)

  b.f = 2 * (*Direction\x * offset\x + *Direction\y * offset\y + *Direction\z * offset\z)
  c.f = offset\x * offset\x + offset\y * offset\y + offset\z * offset\z - radius * radius
  d.f = b * b - 4 * c

  If d > 0 ;hit the sphere
    t.f = (-b - Sqr(d)) * 0.5 ; Could return +ve or -ve number!
  EndIf

  ProcedureReturn t
EndProcedure

Procedure TraceRay(*Origin.xyz,*Direction.xyz,depth.b)
  Intersection.xyz
  Normal.xyz
  *Old_Element=@ObjectList()
  *result.Color
  If depth<#MaxChildren
    Closesthandle=-1
    ClosestT.f=-1
    ResetList(ObjectList())
    For Object=0 To ListSize(ObjectList()) - 1
      NextElement(ObjectList())
      Select ObjectList()\Type
        Case #ObjectType_Sphere
          t.f=TestSphere(*Origin,*Direction,@ObjectList())
          If t>0
            If t<ClosestT Or ClosestT=-1
              Closesthandle=Object
              ClosestT=t
            EndIf
          EndIf
          ;other cases will be added
      EndSelect
    Next Object
    If ClosestT>0
      t=ClosestT
      SelectElement(ObjectList(),Closesthandle)
      VectorScalarMuilply(*Direction,t,Intersection) ;Calulate Interesction point with
      VectorAdd(*Origin,Intersection,Intersection) ;Origin + Direction * T;
      If ObjectList()\Type=#ObjectType_Sphere ;normal Calulations are diffrent per object
        VectorSubtract(Intersection ,ObjectList()\Origin,Normal)
        VectorScalarDivide(Normal,PeekF(@ObjectList()\Primitive),Normal)
        ;other cases will be added
      EndIf
      *result = Shade(Intersection,Normal,*Direction,@ObjectList()\Material,depth)
    EndIf
  EndIf
  ChangeCurrentElement(ObjectList(), *Old_Element)
  If *result=0
    Black.Color
    Black\Red=0
    Black\Green=0
    Black\Blue=0
    *result=@Black
    ProcedureReturn *result
  Else
    ProcedureReturn *result
  EndIf
EndProcedure

Procedure.b RenderScene(*Scene.Scene,*ViewPort.Camera)
  *Color.Color
  For y = -*Scene\HalfScreenHeight To *Scene\HalfScreenHeight - 1
    For x = -*Scene\HalfScreenWidth To *Scene\HalfScreenWidth - 1
      *ViewPort\Direction\x = x
      *ViewPort\Direction\y = y
      *ViewPort\Direction\z = 0
      VectorSubtract(*ViewPort\Direction,*ViewPort\Origin,*ViewPort\Direction)
      VectorNormalize(*ViewPort\Direction)
      *Color=TraceRay(*ViewPort\Origin,*ViewPort\Direction,0)
      If *Color<>0 Or *Color\Red<>0 Or *Color\Green<>0 Or *Color\Blue<>0
        Plot(*Scene\HalfScreenWidth + x, *Scene\HalfScreenHeight + y,RGB(*Color\Red*255,*Color\Green*255,*Color\Blue*255))
      EndIf
    Next x
  Next y
EndProcedure

Procedure TestLoop() ;tester
  Sphere1.Object
  Sphere1Radius.f
  Sphere2.Object
  Sphere2Radius.f
  Light1.PointLight
  light2.PointLight
  MainCamera.Camera
  MainScene.Scene

  Sphere1\Origin\x=-150
  Sphere1\Origin\y=0
  Sphere1\Origin\z=200
  Sphere1\Material\SoildColor\Red=0.25
  Sphere1\Material\SoildColor\Green=0.25
  Sphere1\Material\SoildColor\Blue=0.25
  Sphere1\Material\Diffuse=1
  Sphere1\Material\Reflect=1
  Sphere1\Material\Refract=1
  Sphere1Radius=150

  AddSphereObject(Sphere1,Sphere1Radius)

  Sphere2\Origin\x=150
  Sphere2\Origin\y=0
  Sphere2\Origin\z=100
  Sphere2\Material\SoildColor\Red=0.50
  Sphere2\Material\SoildColor\Green=0
  Sphere2\Material\SoildColor\Blue=0.15
  Sphere2\Material\Diffuse=1
  Sphere2\Material\Reflect=0.27
  Sphere2\Material\Refract=1
  Sphere2Radius=100

  AddSphereObject(Sphere2,Sphere2Radius)

  Light1\Origin\x=-20
  Light1\Origin\y=50
  Light1\Origin\z=50
  Light1\Color\Red=1
  Light1\Color\Green=1
  Light1\Color\Blue=1

  AddPointLightObject(Light1)

  light2\Origin\x=20
  light2\Origin\y=-50
  light2\Origin\z=-50
  light2\Color\Red=1
  light2\Color\Green=1
  light2\Color\Blue=1

  AddPointLightObject(light2)

  MainCamera\Origin\x=0
  MainCamera\Origin\y=0
  MainCamera\Origin\z=-256
  MainCamera\ViewingAngle\x=0
  MainCamera\ViewingAngle\y=0
  MainCamera\ViewingAngle\z=0

  ; MainScene\Ambient\Red=0.125
  ; MainScene\Ambient\Green=0.125 ;not active
  ; MainScene\Ambient\Blue=0.125
  MainScene\ScreenWidth=320*2
  MainScene\ScreenHeight=240*2
  MainScene\HalfScreenWidth=MainScene\ScreenWidth/2
  MainScene\HalfScreenHeight=MainScene\ScreenHeight/2

  InitSprite()
  OpenWindow(0,0,0,MainScene\ScreenWidth,MainScene\ScreenHeight,"PBRay - FPS: 0",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  OpenWindowedScreen(WindowID(0),0,0,MainScene\ScreenWidth,MainScene\ScreenHeight,0,0,0)


  Repeat
    frame+1
    start=ElapsedMilliseconds()

    ClearScreen(RGB(0, 0, 0))
    StartDrawing(ScreenOutput())

    RenderScene(MainScene,MainCamera)

    StopDrawing()
    FlipBuffers()
    stop=ElapsedMilliseconds()
    ;    CallDebugger
    If (stop-start2)>=1000
      start2=ElapsedMilliseconds()
      fps=frame
      frame=0
    EndIf
    SetWindowTitle(0,"PBRay - FPS: "+Str(fps)+" RenderTime: "+Str(stop-start))
  Until WindowEvent() = #PB_Event_CloseWindow
EndProcedure

TestLoop()


; DisableDebugger



Fred
Administrator
Administrator
Posts: 18162
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Re: Raytracing Code from Purearena

Post by Fred »

Before going to raw asm, try the C backend with optimizer ON
User avatar
NicTheQuick
Addict
Addict
Posts: 1504
Joined: Sun Jun 22, 2003 7:43 pm
Location: Germany, Saarbrücken
Contact:

Re: Raytracing Code from Purearena

Post by NicTheQuick »

To make this run on Linux you have to properly design the window event loop:

Code: Select all

	Repeat
		Repeat
			Select WindowEvent()
				Case #PB_Event3D_CloseWindow
					Break 2
				Case 0
					Break
			EndSelect
		ForEver
		frame+1
		start=ElapsedMilliseconds()
		
		ClearScreen(RGB(0, 255, 0))
		StartDrawing(ScreenOutput())
		
		RenderScene(MainScene,MainCamera)
		
		StopDrawing()
		FlipBuffers()
		stop=ElapsedMilliseconds()
		;    CallDebugger
		If (stop-start2)>=1000
			start2=ElapsedMilliseconds()
			fps=frame
			frame=0
		EndIf
		SetWindowTitle(0,"PBRay - FPS: "+Str(fps)+" RenderTime: "+Str(stop-start))
	ForEver
It's not enough to check `WindowEvent()` only once per frame. Check it until it returns 0 or else you will see a black/gray screen on Linux and Mac.

Btw.: With optimizer I get 33 FPS, without only 13. So that makes a huge difference.
The english grammar is freeware, you can use it freely - But it's not Open Source, i.e. you can not change it or publish it in altered way.
Post Reply