RayTracer Theory and Practice

Dreglor · Post by **Dreglor** » Wed Jun 22, 2005 7:28 am

ah well im stoping today,
its late and im tired i managed to put inplace the frame work and write in point light code althought i haven't tested it yet

But theres a ton of bugs...
the screen is black for one and nothing shows

so im going to post the code here so you guys can see whats wrong
im going to sleep on it in hopes to have refresh my brain and hope that i can solve it in the morning if you guys don't frist

Code: Select all

;/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, Reflect, Refract

;- Constants

#Version="Alpha"

#Tolerance=0.0001

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

#TraceFor_Nothing=0 ;NULL basicly, kinda funny thought
#TraceFor_Visables=1
#TraceFor_Lights=2
#TraceFor_Shadows=3

#Render_Nothing=0 ;NULL
#Render_IntersectionTest=1
#Render_Soild=2
#Render_Diffuse=3

#MaxChildren=6

;- 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
   Position.xyz
EndStructure

Structure DirectionalLight
   Color.Color
   Direction.xyz ;normilized
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
  Perspective.f
  ScreenWidth.w
  ScreenHeight.w
  HalfScreenWidth.w
  HalfScreenHeight.w
EndStructure

;- Globals

Global MainScene.Scene

NewList ObjectList.Object()

;- 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 ColorRangeCheck(*a.Color)
  If *a\Red>255
    *a\Red=255
  EndIf
  If *a\Green>255
    *a\Green=255
  EndIf
  If *a\Blue>255
    *a\Blue=255
  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
    m = 1
  Else
    *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
  ProcedureReturn @result
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
  ProcedureReturn @result
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
  ProcedureReturn @result
EndProcedure

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

Procedure.b VectorScalarDivide(*a.xyz, *b.xyz, *result.xyz);returns a pointer to a vector that has been divided
  *result\x = *a\x / *b\x
  *result\y = *a\y / *b\y
  *result\z = *a\z / *b\z
  ProcedureReturn @result
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\e21
  *result\e31 = *this\e31
  *result\e12 = *this\e12
  *result\e22 = *this\e22
  *result\e32 = *this\e32
  *result\e13 = *this\e13
  *result\e23 = *this\e23
  *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 AddPointLightObject(*Light.PointLight,*Origin.xyz)
  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=*Origin\x
  ObjectList()\Origin\y=*Origin\y
  ObjectList()\Origin\z=*Origin\z
  ObjectList()\IsLight=#True
  ObjectList()\Primitive=#Null
EndProcedure

;get and set are not required

Procedure AddDirectionalLightObject(*Light.DirectionalLight,*Direction.xyz)
  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()\Direction\x=*Direction\x
  ObjectList()\Direction\y=*Direction\y
  ObjectList()\Direction\z=*Direction\z
  ObjectList()\IsLight=#True
  ObjectList()\Primitive=#Null
EndProcedure

;get and set are not required

Procedure.b AddSphereObject(*Material.Material,*Origin.xyz,radius.f)
  AddElement(ObjectList())
  ObjectList()\Type=#ObjectType_Sphere
  ObjectList()\Material\SoildColor\Red=*Material\SoildColor\Red
  ObjectList()\Material\SoildColor\Green=*Material\SoildColor\Green
  ObjectList()\Material\SoildColor\Blue=*Material\SoildColor\Blue
  ObjectList()\Material\Diffuse=*Material\Diffuse
  ObjectList()\Material\Reflect=*Material\Reflect
  ObjectList()\Origin\x=*Origin\x
  ObjectList()\Origin\y=*Origin\y
  ObjectList()\Origin\z=*Origin\z
  ObjectList()\IsLight=#False
  ObjectList()\Primitive=AllocateMemory(4)
  PokeF(ObjectList()\Primitive,radius)
EndProcedure

Procedure.b GetSphereStructure(source.l,*destination.Sphere)
  *destination\radius=PeekF(source)
EndProcedure

Procedure.b SetSphereStructure(*source.Sphere,destination.l)
  PokeF(destination,*source\radius)
EndProcedure

Procedure.b RemoveObject()
  If ObjectList()\Primitive<>#Null
    FreeMemory(ObjectList()\Primitive)
  EndIf
  DeleteElement(ObjectList())
EndProcedure

Procedure.l Shade(Type.b,*Intersection.xyz,*Normal.xyz,*Material.Material,*Ambient.Color)
  *Old_Element=@ObjectList()
  result.l
  Color.Color
  Light.xyz
  Temp.Color
  If Type=#Render_IntersectionTest
    If t>0
      result=#Red
    EndIf
  ElseIf Type=#Render_Soild
    result=RGB(*Material\SoildColor\Red,*Material\SoildColor\Green,*Material\SoildColor\Blue)
  ElseIf Type=#Render_Diffuse ;note Lights use material\soildcolor for there emmiting color
    For Object=0 To CountList(ObjectList())
      SelectElement(ObjectList(),Object)
      If ObjectList()\IsLight=#True
        VectorSubtract(ObjectList()\Origin,Intersection,Light)
        VectorNormalize(Light)
        If *Material\Diffuse > 0
          angle.f=VectorDotProduct(*Normal,Light)
          If angle>0
            diff.f=angle**Material\Diffuse
            ColorMuilply(*Material\SoildColor,ObjectList()\Material\SoildColor,Temp)
            ColorScalarMuilply(Temp,diff,Temp)
            ColorAdd(Color,Temp,Color)
          EndIf
        EndIf
      EndIf
    Next Object
    ColorRangeCheck(Color)
    If Color\Red=0 And Color\Green=0 And Color\Blue=0
      result=-1
    Else
      result=RGB(Color\Red,Color\Green,Color\Blue)
    EndIf
  EndIf
  
  ChangeCurrentElement(ObjectList(), *Old_Element) 
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(TraceFor.b,*Origin.xyz,*Direction.xyz,*Ambient.Color,depth.b)
  *Old_Element=@ObjectList()
  If depth<#MaxChildren
    Select TraceFor
      Case #TraceFor_Visables
        Closesthandle=-1
        ClosestT=-1
        For Object=0 To CountList(ObjectList())
          SelectElement(ObjectList(),Object)
          Select ObjectList()\Type
            Case #ObjectType_Sphere
              t.f=TestSphere(*Origin,*Direction,@ObjectList())
              If t>0
                If t<ClosestT
                  Closesthandle=Object
                  ClosestT=t
                EndIf
              EndIf
            ;other cases will be added
          EndSelect
        Next Object
        If ClosestT>=0
          t=ClosestT
          SelectElement(ObjectList(),Closesthandle)
          Intersection.xyz
          Normal.xyz
          VectorScalarMuilply(*Direction,t,Intersection)
          VectorAdd(*Origin,Intersection,Intersection)
          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
          Shade(#Render_IntersectionTest,Intersection.xyz,Normal.xyz,ObjectList()\Material,*Ambient)
        EndIf
      Case #TraceFor_Lights
        ; #ObjectType_PointLight
      Case #TraceFor_Shadows
        ; #ObjectType_PointLight
    EndSelect
  EndIf
  ChangeCurrentElement(ObjectList(), *Old_Element) 
EndProcedure

Procedure RenderScene(*Scene.Scene,*ViewPort.Camera)
  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 = *Scene\Perspective
      Color=TraceRay(#TraceFor_Visables,*ViewPort\Origin,*ViewPort\Direction,*Scene\Ambient,0)
      Plot(posx, posy, Color)
    Next x
  Next y
EndProcedure

Procedure TestLoop() ;tester
  CallDebugger
  Sphere1Mat.Material
  Sphere1Center.xyz
  Sphere1Radius.f
  MainCamera.Camera
  MainScene.Scene
  
  Sphere1Center\x=0
  Sphere1Center\y=0
  Sphere1Center\z=0
  Sphere1Mat\SoildColor\Red=0
  Sphere1Mat\SoildColor\Green=0
  Sphere1Mat\SoildColor\Blue=255
  Sphere1Mat\Diffuse=1.0
  Sphere1Mat\Reflect=0
  Sphere1Mat\Refract=0
  Sphere1Radius=100
  
  AddSphereObject(Sphere1Mat,Sphere1Center,Sphere1Radius)
  
  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=32
  MainScene\Ambient\Green=32
  MainScene\Ambient\Blue=32
  MainScene\Perspective=256
  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,#PB_Window_ScreenCentered,"PBRay - FPS: 0")
  OpenWindowedScreen(WindowID(),0,0,MainScene\ScreenWidth,MainScene\ScreenHeight,0,0,0)
  
  start=ElapsedMilliseconds()
  
  Repeat
    frame+1
    
    ClearScreen(0, 0, 0)
    StartDrawing(ScreenOutput())
    
    RenderScene(MainScene,MainCamera)
    
    StopDrawing()
    FlipBuffers(1)
    
    If ElapsedMilliseconds()-start>1000
      start=ElapsedMilliseconds()
      SetWindowTitle(0,"PBRay - FPS: "+Str(frame))
      frame=0
    EndIf
  Until WindowEvent() = #PB_Event_CloseWindow
EndProcedure

TestLoop()

MrMat · Post by **MrMat** » Wed Jun 22, 2005 2:03 pm

Fixed a few bugs:

Code: Select all

;/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, Reflect, Refract

;- Constants

#Version="Alpha"

#Tolerance=0.0001

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

#TraceFor_Nothing=0 ;NULL basicly, kinda funny thought
#TraceFor_Visables=1
#TraceFor_Lights=2
#TraceFor_Shadows=3

#Render_Nothing=0 ;NULL
#Render_IntersectionTest=1
#Render_Soild=2
#Render_Diffuse=3

#MaxChildren=6

;- 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
   Position.xyz
EndStructure

Structure DirectionalLight
   Color.Color
   Direction.xyz ;normilized
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
  Perspective.f
  ScreenWidth.w
  ScreenHeight.w
  HalfScreenWidth.w
  HalfScreenHeight.w
EndStructure

;- Globals

Global MainScene.Scene

NewList ObjectList.Object()

;- 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 ColorRangeCheck(*a.Color)
  If *a\Red>255
    *a\Red=255
  EndIf
  If *a\Green>255
    *a\Green=255
  EndIf
  If *a\Blue>255
    *a\Blue=255
  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
  ProcedureReturn @result
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
  ProcedureReturn @result
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
  ProcedureReturn @result
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
  ProcedureReturn @result
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
  ProcedureReturn @result
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 AddPointLightObject(*Light.PointLight,*Origin.xyz)
  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=*Origin\x
  ObjectList()\Origin\y=*Origin\y
  ObjectList()\Origin\z=*Origin\z
  ObjectList()\IsLight=#True
  ObjectList()\Primitive=#Null
EndProcedure

;get and set are not required

Procedure AddDirectionalLightObject(*Light.DirectionalLight,*Direction.xyz)
  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()\Direction\x=*Direction\x
  ObjectList()\Direction\y=*Direction\y
  ObjectList()\Direction\z=*Direction\z
  ObjectList()\IsLight=#True
  ObjectList()\Primitive=#Null
EndProcedure

;get and set are not required

Procedure.b AddSphereObject(*Material.Material,*Origin.xyz,radius.f)
  AddElement(ObjectList())
  ObjectList()\Type=#ObjectType_Sphere
  ObjectList()\Material\SoildColor\Red=*Material\SoildColor\Red
  ObjectList()\Material\SoildColor\Green=*Material\SoildColor\Green
  ObjectList()\Material\SoildColor\Blue=*Material\SoildColor\Blue
  ObjectList()\Material\Diffuse=*Material\Diffuse
  ObjectList()\Material\Reflect=*Material\Reflect
  ObjectList()\Origin\x=*Origin\x
  ObjectList()\Origin\y=*Origin\y
  ObjectList()\Origin\z=*Origin\z
  ObjectList()\IsLight=#False
  ObjectList()\Primitive=AllocateMemory(4)
  PokeF(ObjectList()\Primitive,radius)
EndProcedure

Procedure.b GetSphereStructure(source.l,*destination.Sphere)
  *destination\radius=PeekF(source)
EndProcedure

Procedure.b SetSphereStructure(*source.Sphere,destination.l)
  PokeF(destination,*source\radius)
EndProcedure

Procedure.b RemoveObject()
  If ObjectList()\Primitive<>#Null
    FreeMemory(ObjectList()\Primitive)
  EndIf
  DeleteElement(ObjectList())
EndProcedure

Procedure.l Shade(Type.b,*Intersection.xyz,*Normal.xyz,*Material.Material,*Ambient.Color)
  *Old_Element=@ObjectList()
  result.l
  Color.Color
  Light.xyz
  Temp.Color
  If Type=#Render_IntersectionTest
    If t>0
      result=#Red
    EndIf
  ElseIf Type=#Render_Soild
    result=RGB(*Material\SoildColor\Red,*Material\SoildColor\Green,*Material\SoildColor\Blue)
  ElseIf Type=#Render_Diffuse ;note Lights use material\soildcolor for there emmiting color
    For Object=0 To CountList(ObjectList())
      SelectElement(ObjectList(),Object)
      If ObjectList()\IsLight=#True
        VectorSubtract(ObjectList()\Origin,Intersection,Light)
        VectorNormalize(Light)
        If *Material\Diffuse > 0
          angle.f=VectorDotProduct(*Normal,Light)
          If angle>0
            diff.f=angle**Material\Diffuse
            ColorMuilply(*Material\SoildColor,ObjectList()\Material\SoildColor,Temp)
            ColorScalarMuilply(Temp,diff,Temp)
            ColorAdd(Color,Temp,Color)
          EndIf
        EndIf
      EndIf
    Next Object
    ColorRangeCheck(Color)
    If Color\Red=0 And Color\Green=0 And Color\Blue=0
      result=-1
    Else
      result=RGB(Color\Red,Color\Green,Color\Blue)
    EndIf
  EndIf

  ChangeCurrentElement(ObjectList(), *Old_Element)
  ProcedureReturn result
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(TraceFor.b,*Origin.xyz,*Direction.xyz,*Ambient.Color,depth.b)
  *Old_Element=@ObjectList()
  result.l
  If depth<#MaxChildren
    Select TraceFor
      Case #TraceFor_Visables
        Closesthandle=-1
        ClosestT.f=-1
        For Object=0 To CountList(ObjectList())
          SelectElement(ObjectList(),Object)
          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)
          Intersection.xyz
          Normal.xyz
          VectorScalarMuilply(*Direction,t,Intersection)
          VectorAdd(*Origin,Intersection,Intersection)
          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(#Render_Diffuse,Intersection.xyz,Normal.xyz,ObjectList()\Material,*Ambient)
        EndIf
      Case #TraceFor_Lights
        ; #ObjectType_PointLight
      Case #TraceFor_Shadows
        ; #ObjectType_PointLight
    EndSelect
  EndIf
  ChangeCurrentElement(ObjectList(), *Old_Element)
  ProcedureReturn result
EndProcedure

Procedure RenderScene(*Scene.Scene,*ViewPort.Camera)
  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 = *Scene\Perspective
      VectorNormalize(*ViewPort\Direction)
      Color=TraceRay(#TraceFor_Visables,*ViewPort\Origin,*ViewPort\Direction,*Scene\Ambient,0)
      Plot(*Scene\HalfScreenWidth + x, *Scene\HalfScreenHeight + y, Color)
    Next x
  Next y
EndProcedure

Procedure TestLoop() ;tester
;  CallDebugger
  Sphere1Mat.Material
  Sphere1Center.xyz
  Sphere1Radius.f
  MainCamera.Camera
  MainScene.Scene

  Sphere1Center\x=0
  Sphere1Center\y=0
  Sphere1Center\z=200
  Sphere1Mat\SoildColor\Red=0
  Sphere1Mat\SoildColor\Green=0
  Sphere1Mat\SoildColor\Blue=255
  Sphere1Mat\Diffuse=1.0
  Sphere1Mat\Reflect=0
  Sphere1Mat\Refract=0
  Sphere1Radius=100

  AddSphereObject(Sphere1Mat,Sphere1Center,Sphere1Radius)

  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=32
  MainScene\Ambient\Green=32
  MainScene\Ambient\Blue=32
  MainScene\Perspective=256
  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,#PB_Window_SystemMenu|#PB_Window_ScreenCentered,"PBRay - FPS: 0")
  OpenWindowedScreen(WindowID(),0,0,MainScene\ScreenWidth,MainScene\ScreenHeight,0,0,0)

  start=ElapsedMilliseconds()

  Repeat
    frame+1

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

    RenderScene(MainScene,MainCamera)

    StopDrawing()
    FlipBuffers(1)

    If ElapsedMilliseconds()-start>1000
      start=ElapsedMilliseconds()
      SetWindowTitle(0,"PBRay - FPS: "+Str(frame))
      frame=0
    EndIf
  Until WindowEvent() = #PB_Event_CloseWindow
EndProcedure

TestLoop()

The vector multiply/divide by a scalar procedures have been fixed and the matrix transpose procedure didn't look right so i changed that (i didn't check all the vector/matrix procedures so there may still be bugs). The colours weren't being returned by a couple of procedures so that was added. The direction vector wasn't being normalised and the plotting was taking place at an undefined x,y. I changed the shade mode to #Render_Diffuse because the #Render_IntersectionTest mode uses t which isn't being passed to the shade procedure. I think the #Render_Diffuse mode isn't working either but at least you can see the sphere!

Dreglor · Post by **Dreglor** » Wed Jun 22, 2005 8:08 pm

well thats what i get for trying to code at 2 in the morning

now it my turn to fix things
thank you again mr mat

Dreglor · Post by **Dreglor** » Thu Jun 23, 2005 12:27 am

2 Spheres and one light my muilt object frame work is working

not bad for something that was done at 2 am

Amiga5k · Post by **Amiga5k** » Thu Jun 23, 2005 5:36 am

Well, my hat's off to you, Dreglor (from the planet Meepzorp?): Raytracing is not something that the faint of heart would address AND there are lots of raytracers already out there - Nice to see that you still want to know how it's done anyway!

AT the rate that hardware is progressing (PS3, XBOX 360, etc), realtime raytracing is probably not far off. But until then...

Good luck!

Russell

yashaa · Post by **yashaa** » Thu Jun 23, 2005 8:49 am

Amiga5k wrote:AT the rate that hardware is progressing (PS3, XBOX 360, etc), realtime raytracing is probably not far off. But until then...

Haven't tried yet, but this looks great:

http://graphics.cs.uni-sb.de/~sidapohl/egoshooter/

all thanks to this awesome german project:

http://www.openrt.de/

edit:

realtime with virtual intel CPU with about 36 GHz
yes, 36 !!!

Dreglor · Post by **Dreglor** » Thu Jun 23, 2005 10:27 am

thanks amiga5k.
yeah i seen the openrt project before.
its so fast becasue the hardware is independet to the os which means it all there for the raytracing

Dreglor · Post by **Dreglor** » Thu Jun 23, 2005 11:14 am

Well another day another snapshot thats filled with bugs
it kinda funny how at the very end of my programming spree of the day which is around 2am.
bugs start poping up and i can't find where there comming from.
so here is the small list of things i added\changed today

added reflection
changed shaded procedure so it wasn't checking for useless rendering types
minor optimaztions of the shade procedure
minor optimaztions of the traceray procedure
optmized the add\get\set procedures
fixed the colorcheck procedure

now for the known bugs that im in the process of fixing
right now all i can see is black and this is becasue the traceray procedure seams to be not hitting anything or so it seams
this is becasue when i changed the add\get\set procedures for the sphere it seam to screw up somthing in the list or the structure...
anyways i checked the list during runtime and it seam to contain the data it was supposed to have.

next is the reflections they crash the program when you have them enabled (sphere having reflection > 0) it seamt to be a bug with the reflectioncolor pointer the traceray procedure called isn't returning the pointer correctly it was working partally i saw reflections but both spheres were a certain color when i changed certain things the pointer being returned changed and then started to chrash it

thats the 2 big bugs im working out
if you can solve them here before i wake up and start working go right ahead

take a wack at the code if you like just keep the comments at the top alone

Code: Select all

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

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 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 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 CountList(ObjectList())>0 And *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)
  result.l=@ObjectList()
  If CountList(ObjectList())>0 And *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 CountList(ObjectList())>0 And *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 CountList(ObjectList())>0 And *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
  ResetList(ObjectList())
  For Object=0 To CountList(ObjectList())
    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())
      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 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,#PB_Window_SystemMenu|#PB_Window_ScreenCentered,"PBRay - FPS: 0")
  OpenWindowedScreen(WindowID(),0,0,MainScene\ScreenWidth,MainScene\ScreenHeight,0,0,0)
  
  
  Repeat
    frame+1
    start=ElapsedMilliseconds()
    
    ClearScreen(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()

MrMat · Post by **MrMat** » Thu Jun 23, 2005 12:36 pm

I think this is working Dreglor:

Code: Select all

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

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 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 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 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,#PB_Window_SystemMenu|#PB_Window_ScreenCentered,"PBRay - FPS: 0")
  OpenWindowedScreen(WindowID(),0,0,MainScene\ScreenWidth,MainScene\ScreenHeight,0,0,0)


  Repeat
    frame+1
    start=ElapsedMilliseconds()

    ClearScreen(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()

I didn't change much, the main bit was adding ObjectList()\Type=#ObjectType_Sphere to the AddSphereObject procedure. I changed a couple of loops to For Object=0 To CountList(ObjectList()) - 1 (if there are n elements they are numbered 0 to n - 1). The tempvec in the Shade procedure didn't have a type so that is added and the reflection code runs without crashing but i don't think it is working. I'll let you sort that out

Post by **Dare2** » Thu Jun 23, 2005 2:29 pm

Shoot.

Another "ducks guts" thread. You guys are awesome.

Dreglor · Post by **Dreglor** » Thu Jun 23, 2005 4:57 pm

yeah the reflection is still returning a bad pointer grr
i see what i can do

MrMat · Post by **MrMat** » Thu Jun 23, 2005 7:34 pm

Code: Select all

;/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
#PI=3.14159265

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

NewList ObjectList.Object()

;- Declares

Declare.l TestLoop();tester
Declare.b RenderScene(*Scene.Scene, *ViewPort.Camera,angle.l)
Declare.l TraceRay(*Origin.xyz, *Direction.xyz, depth.b, *res.Color)
Declare.f TestSphere(*Origin.xyz, *Direction.xyz, *Sphere.Object)
Declare.l Shade(*Intersection.xyz,*Normal.xyz,*Direction.xyz,*Material.Material,depth.b,*res.Color)
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 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 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 Shade(*Intersection.xyz,*Normal.xyz,*Direction.xyz,*Material.Material,depth.b,*Accumalated.Color)
  *Old_Element=@ObjectList()
  *result.Color
  Color.Color
  Light.xyz
  Relfection.xyz
  reflectcolor.Color
  ReflectOrigin.xyz
  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
          TraceRay(ReflectOrigin,Relfection,depth+1,reflectcolor)
          SelectElement(ObjectList(), Object)
          ColorScalarMuilply(reflectcolor,*Material\Reflect,Color.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)
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,*res.Color)
  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
      Shade(Intersection,Normal,*Direction,ObjectList()\Material,depth,result)
    EndIf
  EndIf
  ChangeCurrentElement(ObjectList(), *Old_Element)
  *res\Red = result\Red
  *res\Green = result\Green
  *res\Blue = result\Blue
EndProcedure

Procedure RenderScene(*Scene.Scene,*ViewPort.Camera,angle)
  Color.Color
  For y = -*Scene\HalfScreenHeight To *Scene\HalfScreenHeight - 1
    For x = -*Scene\HalfScreenWidth To *Scene\HalfScreenWidth - 1
      *ViewPort\Origin\x=-1000 * Sin(angle * #PI / 180)
      *ViewPort\Origin\y=0
      *ViewPort\Origin\z=-1000 * Cos(angle * #PI / 180)
      *ViewPort\Direction\x = 1000 * Sin((angle + 0.1*x) * #PI / 180)
      *ViewPort\Direction\y = 2*y
      *ViewPort\Direction\z = 1000 * Cos((angle + 0.1*x) * #PI / 180)
      VectorSubtract(*ViewPort\Direction,*ViewPort\Origin,*ViewPort\Direction)
      VectorNormalize(*ViewPort\Direction)
      TraceRay(*ViewPort\Origin,*ViewPort\Direction,0,Color)
      If 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=-170
  Sphere1\Origin\y=0
  Sphere1\Origin\z=0
  Sphere1\Material\SoildColor\Red=0.75
  Sphere1\Material\SoildColor\Green=0.25
  Sphere1\Material\SoildColor\Blue=0.25
  Sphere1\Material\Diffuse=1
  Sphere1\Material\Reflect=1
  Sphere1\Material\Refract=0
  Sphere1Radius=150
  
  AddSphereObject(Sphere1,Sphere1Radius)
  
  Sphere2\Origin\x=120
  Sphere2\Origin\y=0
  Sphere2\Origin\z=0
  Sphere2\Material\SoildColor\Red=0.25
  Sphere2\Material\SoildColor\Green=0.25
  Sphere2\Material\SoildColor\Blue=0.75
  Sphere2\Material\Diffuse=1
  Sphere2\Material\Reflect=1
  Sphere2\Material\Refract=0
  Sphere2Radius=100
  
  AddSphereObject(Sphere2,Sphere2Radius)
  
  Light1\Origin\x=-200
  Light1\Origin\y=200
  Light1\Origin\z=200
  Light1\Color\Red=1
  Light1\Color\Green=1
  Light1\Color\Blue=1
  
  AddPointLightObject(Light1)
  
  Light2\Origin\x=0
  Light2\Origin\y=-100
  Light2\Origin\z=-100
  Light2\Color\Red=1
  Light2\Color\Green=1
  Light2\Color\Blue=1
  
  AddPointLightObject(Light2)

  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,#PB_Window_SystemMenu|#PB_Window_ScreenCentered,"PBRay - FPS: 0")
  OpenWindowedScreen(WindowID(),0,0,MainScene\ScreenWidth,MainScene\ScreenHeight,0,0,0)
  
  
  angle.l = 0
  
  Repeat
    angle+3
    frame+1
    start=ElapsedMilliseconds()
    
    ClearScreen(0, 0, 0)
    StartDrawing(ScreenOutput())
    
    RenderScene(MainScene,MainCamera,angle)
    
    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)+" Angle: "+Str(angle))
  Until WindowEvent() = #PB_Event_CloseWindow
EndProcedure

TestLoop()

Maybe the reflection is working now?

Marcel · Post by **Marcel** » Thu Jun 23, 2005 8:55 pm

Hey, that looks great!

Go on, go on!

MrMat · Post by **MrMat** » Thu Jun 23, 2005 11:43 pm

hehe. I've edited by previous post so that the camera rotates around the scene. Dreglor is going away on holiday so there won't be any more updates until he comes back.

Blade · Post by **Blade** » Thu Jun 23, 2005 11:43 pm

Reflections! Yeahhhh!!!!

I added

Code: Select all

MainCamera\Origin\x-5

inside the main loop to mak things move, and the sphere becomes stretched...
My fault or something wrong? Perhaps too big FOV?

Keep going on with this thread!!!