Page 4 of 9

Posted: Thu Jun 23, 2005 11:45 pm
by MrMat
I believe it gets stretched because the viewpoint isn't being updated. It took a bit of fiddling to get it to look nice in my updated post above. I'm sure Dreglor will continue with it when he returns :-D

Posted: Fri Jun 24, 2005 6:37 am
by Dreglor
im not on holiday yet.
when i get back im hoping to do (in order of priority)
persective fix (the perspective is not being repesented correctly)
camera transforms a moveable camera (right now only the origin is being moved, the direction has to be changed to display correctly)
shadows
phong shading
plane primitive
box primitive
triangle primitive
subsampling (to improve speed)
textures
trimesh primitive (mesh object basicly)
hyper thread\dual core processing surrport
file loading
and any others i can think up while im on my vaction :D
i will be bring a notepad and a a bunch of raytracing documents so i be ready when i get back ;)

if you guys want improve on anything go right ahead im not stopping you

oh and for those who want a quick taste of the relfections here you go
Image

wow mrmat that rotation scene so sweet!

just a note, ill be gone for 2 weeks

Posted: Fri Jun 24, 2005 8:01 am
by Dare2
Enjoy your holiday.

Posted: Fri Jun 24, 2005 3:02 pm
by Dreglor
see you guys in 2 weeks :)

Posted: Fri Jun 24, 2005 3:33 pm
by MrMat
Enjoy yourself Dreglor :-) The to-do list sounds great!

Posted: Thu Jul 07, 2005 1:50 am
by Dreglor
im back :D
I have been doing a few things while on my vacation and i will post a code and new screens showing off a few features soon

Posted: Thu Jul 07, 2005 8:08 am
by Dreglor
OK, i got good news and bad news
good news is that
i got the plane primitve, phong shading (spectcular), shadows, persective working
and i have nice looking hires screen shots for you (800x600 not incredable but bigger than 320x240 :P)
the bad news is
it slow as hell (3 seconds per frame ouch) , and theres somthing wrong with the y axis so shadows and phong shading are screwed up because of it.
the image originaly was upside down when i fixed it so i flipped the the y direction and that fixed it

before i go to far let me tell you what all the small details of what i discoved while taking my holiday.
i think the main thing slowing the raytracer is its procedure calls if i merge some of the procedures (like shade and raytrace) together and maybe make a branch of code with inline vector math im sure i see a huge increase.
the problem with the persective was that i was sending rays straight from the screen size so it was a ratio of 1:1 so and all the space from x to x+1 was being missed. so shooting rays through a small "pin hole" like opening
everything was scaled in are case the opening is 8x6 in a 800x600 screen making everything 100x bigger on screen
im not sure if this is subsampling or not but i been thinking of a way to reduce rays traced by increasing and decreaseing step size determided by the diffreneces in color.
example if theres a area of black and the diffrence is below some tolerance increase the step size every low change until the change is high enough for example a sphere is in the space that its sampling and it above the tolerance then the step size will be reduced ofcourse there will be step limits
but i think i won't be adding that until i get my ray tracer stable and working again

so, here are some nice (but showing the bugs) screen shots of the scene done from a artical from http://www.flipcode.com/articles/articl ... ce01.shtml
it should look like this
Image
but in fact it looks like this (frist 2 don't have shadows enabled)
Image
the image above has both lights above
the image below has one under it
Image
the dark spots on the floor are supose to be the shadows you can tell that its not working quite well :\
Image

here is the working code right now
you may notice the profiling and debuging code i put in it all commeted out though becasue it increases the render time quite a bit
if any one with asm and/or optimizing skills please help me speed this guy up :D
i know it possible

Code: Select all

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

;- Constants

#Version="Alpha"

#Tolerance=0.0001

#ObjectType_Null=0
#ObjectType_PointLight=1
#ObjectType_Sphere=2
#ObjectType_Plane=3
#ObjectType_Triangle=4

#MaxChildren=6

#EPSILON=0.0001

;- Structures

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

Structure VectorMatrix
  e1.f
  e2.f
  e3.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
  Apature.f ;exposure control
EndStructure

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

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

Structure PointLight
  Color.Color
  Origin.xyz
EndStructure

Structure Sphere
  radius.f
EndStructure

Structure Plane
  Distance.xyz
EndStructure

Structure Triangle
  v1.xyz
  v2.xyz
  v3.xyz
EndStructure

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

Structure Scene
  Ambient.Color
  WorldScreenSize.f
  WorldScreenWidth.f
  WorldScreenHieght.f
  WorldScreenHalfWidth.f
  WorldScreenHalfHeight.f
  ScreenWidth.w
  ScreenHeight.w
  HalfScreenWidth.w
  HalfScreenHeight.w
  PixelStep.f
EndStructure

;- Globals

Global MainScene.Scene
Global LastProcedur; etime.l

NewList ObjectList.Object()

;- Declares

Declare.l TestLoop();tester
Declare.b RenderScene(*Scene.Scene, *ViewPort.Camera)
Declare.l TraceRay(*Origin.xyz, *Direction.xyz, depth.b, *res.Color)
Declare.f TestSphere(*Origin.xyz, *Direction.xyz, *Sphere.Object)
Declare.f TestPlane(*Origin.xyz,*Direction.xyz,*Plane.Object)
Declare.f TestTriangle(*Origin.xyz,*Direction.xyz,*Triangle.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 AddTriangleObject(*Triangle.Object,*v1.xyz,*v2.xyz,*v3.xyz,*Normal.xyz)
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
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering ColorScalarMuilply() With "+Hex(*a)+", "+Str(b)+", "+Hex(*result)
  *result\Red = *a\Red * b
  *result\Green = *a\Green * b
  *result\Blue = *a\Blue * b
  ; Debug "Leaving ColorScalarMuilply()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b ColorMuilply(*a.Color, *b.Color, *result.Color);returns a pointer to a Color that has been muiltiplied
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering ColorMuilply() With "+Hex(*a)+", "+Hex(*b)+", "+Hex(*result)
  *result\Red = *a\Red * *b\Red
  *result\Green = *a\Green * *b\Green
  *result\Blue = *a\Blue * *b\Blue
  ; Debug "Leaving ColorMuilply()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b ColorAdd(*a.Color, *b.Color, *result.Color);returns a pointer to a Color that has been added
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering ColorAdd() With"+Hex(*a)+", "+Hex(*b)+", "+Hex(*result)
  *result\Red = *a\Red + *b\Red
  *result\Green = *a\Green + *b\Green
  *result\Blue = *a\Blue + *b\Blue
  ; Debug "Leaving ColorAdd()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure ColorRangeCheck(*a.Color)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering ColorRangeCheck() With"+Hex(*a)
  If *a\Red>255
    *a\Red=255
  EndIf
  If *a\Green>255
    *a\Green=255
  EndIf
  If *a\Blue>255
    *a\Blue=255
  EndIf
  ; Debug "Leaving ColorRangeCheck()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

;-Vector Math

Procedure.f VectorMagnitude(*this.xyz);returns the maginitude of a Vector
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorMagnitude() With"+Hex(*this)
  result.f=Sqr((*this\x * *this\x)+(*this\y * *this\y)+(*this\z * *this\z))
  ; Debug "Leaving VectorMagnitude() With"+ StrF(result)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
EndProcedure

Procedure.f VectorDotProduct(*a.xyz, *b.xyz)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorDotProduct() With"+Hex(*a)+", "+Hex(*b)
  result.f=*a\x * *b\x + *a\y * *b\y + *a\z * *b\z
  ; Debug "Leaving VectorDotProduct() With"+StrF(result)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
EndProcedure

Procedure.b VectorNormalize(*this.xyz);normilzes a vector
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorNormalize() With"+Hex(*this)
  m.f = VectorMagnitude(*this)
  If m > #Tolerance
    VectorScalarDivide(*this,m,*this)
  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
  ; Debug "Leaving VectorNormalize()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b VectorReverse(*this.xyz);reverses a Vector
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorReverse() With"+Hex(*this)
  *this\x = -*this\x
  *this\y = -*this\y
  *this\z = -*this\z
  ; Debug "Leaving VectorReverse()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b VectorCrossMuiltply(*a.xyz, *b.xyz, *result.xyz);returns a pointer to a vector that has been crossed muiltiplied
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorCrossMuiltply() With"+Hex(*a)+", "+Hex(*b)+", "+Hex(*result)
  *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
  ; Debug "Leaving VectorCrossMuiltply()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b VectorAdd(*a.xyz, *b.xyz, *result.xyz);returns a pointer to a vector that has been added
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorAdd() With"+Hex(*a)+", "+Hex(*b)+", "+Hex(*result)
  *result\x = *a\x + *b\x
  *result\y = *a\y + *b\y
  *result\z = *a\z + *b\z
  ; Debug "Leaving VectorAdd()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b VectorSubtract(*a.xyz, *b.xyz, *result.xyz);returns a pointer to a vector that has been Subtracted
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorSubtract() With"+Hex(*a)+", "+Hex(*b)+", "+Hex(*result)
  *result\x = *a\x - *b\x
  *result\y = *a\y - *b\y
  *result\z = *a\z - *b\z
  ; Debug "Leaving VectorSubtract()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b VectorScalarMuilply(*a.xyz, b.f, *result.xyz);returns a pointer to a vector that has been muiltiplied
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorScalarMuilply() With"+Hex(*a)+", "+Str(*b)+", "+Hex(*result)
  *result\x = *a\x * b
  *result\y = *a\y * b
  *result\z = *a\z * b
  ; Debug "Leaving VectorScalarMuilply()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b VectorScalarDivide(*a.xyz, b.f, *result.xyz);returns a pointer to a vector that has been divided
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorScalarDivide() With"+Hex(*a)+", "+Str(*b)+", "+Hex(*result)
  *result\x = *a\x / b
  *result\y = *a\y / b
  *result\z = *a\z / b
  ; Debug "Leaving VectorScalarDivide()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.f VectorTripleScalarProduct(*a.xyz, *b.xyz, *c.xyz);returns triple scalar product of 3 vectors
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorTripleScalarProduct() With"+Hex(*a)+", "+Hex(*b)+", "+Hex(*c)
  result.f=*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))
  ; Debug "Leaving VectorTripleScalarProduct() With"+StrF(result)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
EndProcedure

;-Matrix Math

Procedure.f MatrixDeterminant(*this.Matrix);returns the determiant of a matrix
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering MatrixDeterminant() With"+Hex(*this)
  result.f=*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
  ; Debug "Leaving MatrixDeterminant() With"+StrF(result)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
EndProcedure

Procedure.w MatrixTranspose(*this.Matrix, *result.Matrix);returns the transpose of a matrix
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering MatrixTranspose() With"+Hex(*this)+", "+Hex(*result)
  *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
  ; Debug "Leaving MatrixTranspose()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.w MatrixInverse(*this.Matrix);returns the inverse of a matrix
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering MatrixInverse() With"+Hex(*this)
  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
  ; Debug "Leaving MatrixInverse()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.w MatrixAdd(*a.Matrix, *b.Matrix, *result.Matrix);adds 2 matrice together
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering MatrixAdd() With"+Hex(*a)+" ,"+Hex(*b)+" ,"+Hex(*result)
  *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
  ; Debug "Leaving MatrixAdd()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.w MatrixSubtract(*a.Matrix, *b.Matrix, *result.Matrix);subtract 2 matrice together
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering MatrixSubtract() With"+Hex(*a)+" ,"+Hex(*b)+" ,"+Hex(*result)
  *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
  ; Debug "Leaving MatrixSubtract()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.w MatrixScalarMuiltply(*a.Matrix, Scalar.f, *result.Matrix);muiltplies a matrix to a scalar
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering MatrixScalarMuiltply() With"+Hex(*a)+", "+StrF(Scalar)+", "+Hex(*result)
  *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
  ; Debug "Leaving MatrixScalarMuiltply()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.w MatrixScalarDivision(*a.Matrix, Scalar.f, *result.Matrix);divides a matrix to a scalar
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering MatrixScalarDivision() With"+Hex(*a)+", "+StrF(Scalar)+", "+Hex(*result)
  *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
  ; Debug "Leaving MatrixScalarDivision()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

;-FrameWork

Procedure AddPointLightObject(*Light.PointLight)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering AddPointLightObject() With"+Hex(*Light)
  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
  ; Debug "Leaving AddPointLightObject()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
  
EndProcedure

Procedure.b AddSphereObject(*Sphere.Object,radius.f)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering AddSphereObject() With"+Hex(*Sphere)+", "+StrF(radius)
  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
  ; Debug "Leaving AddSphereObject() With"+Hex(result)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
EndProcedure

Procedure AddPlaneObject(*Plane.Object,Distance.f)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering AddPlaneObject() With"+Hex(*Plane)+StrF(Distance)
  If CountList(ObjectList())>0
    *Old_Element = @ObjectList()
  EndIf
  AddElement(ObjectList())
  ;copy object data into the new object
  CopyMemory(*Plane,@ObjectList(),SizeOf(Object))
  ;put any primtive specific data into there places
  ObjectList()\Type=#ObjectType_Plane
  ObjectList()\Primitive=AllocateMemory(4)
  PokeF(ObjectList()\Primitive,Distance)
  result.l=@ObjectList()
  ; Debug "Leaving AddPlaneObject() With"+Hex(result)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
EndProcedure

Procedure.b AddTriangleObject(*Triangle.Object,*v1.xyz,*v2.xyz,*v3.xyz,*Normal.xyz)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering AddTriangleObject() With"+Hex(*Triangle)+", "+Hex(*v1)+", "+Hex(*v2)+", "+Hex(*v3)+", "+Hex(*Normal)
  If CountList(ObjectList())>0
    *Old_Element = @ObjectList()
  EndIf
  AddElement(ObjectList())
  ;copy object data into the new object
  CopyMemory(*Triangle,@ObjectList(),SizeOf(Object))
  ;put any primtive specific data into there places
  ObjectList()\Primitive=AllocateMemory(48)
  CopyMemory(*v1,ObjectList()\Primitive,12)
  CopyMemory(*v2,ObjectList()\Primitive+12,12)
  CopyMemory(*v3,ObjectList()\Primitive+24,12)
  CopyMemory(*Normal,ObjectList()\Primitive+36,12)
  ObjectList()\Type=#ObjectType_Triangle
  result.l=@ObjectList()
  If *Old_Element<>#Null
    ChangeCurrentElement(ObjectList(), *Old_Element)
  EndIf
  result.l=@ObjectList()
  ; Debug "Leaving AddTriangleObject() With"+Hex(result)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
EndProcedure

Procedure.b GetObjectStructure(ObjectPointer,*destination.Object)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering GetObjectStructure() With"+Hex(ObjectPointer)+", "+Hex(*destination)
  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
  ; Debug "Leaving GetObjectStructure()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b SetObjectStructure(ObjectPointer,*source.Object)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering SetObjectStructure() With"+Hex(ObjectPointer)+", "+Hex(*source)
  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
  ; Debug "Leaving SetObjectStructure()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b RemoveObject(ObjectPointer)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering RemoveObject() With"+Hex(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
  ; Debug "Leaving RemoveObject()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure Shade(*Intersection.xyz,*Normal.xyz,*Direction.xyz,*Material.Material,depth.b,*Accumalated.Color)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering Shade() With"+Hex(*Intersection)+", "+Hex(*Normal)+", "+Hex(*Direction)+", "+Hex(*Material)+", "+Str(depth)+", "+Hex(*Accumalated)
  *Old_Element=@ObjectList()
  *result.Color
  Color.Color
  Light.xyz
  Relfection.xyz
  reflectcolor.Color
  ReflectOrigin.xyz
  tempvec.xyz
  l.xyz
  rayo.xyz
  rayd.xyz
  ResetList(ObjectList())
  For Object=0 To CountList(ObjectList()) - 1
    NextElement(ObjectList())
    If ObjectList()\IsLight=#True
      VectorSubtract(*Intersection,ObjectList()\Origin,Light) ;Origin - Intersection;
      VectorNormalize(Light)
      ;this shadow test only works with point light
      shade.f=1
      tdist.f=VectorMagnitude(Light)
      VectorScalarDivide(Light,tdist,l)
      VectorScalarMuilply(l,#EPSILON,tempvec)
      VectorAdd(*Intersection,tempvec,rayo)
      rayd\x=l\x
      rayd\y=l\y
      rayd\z=l\z
      *Old_Element2=@ObjectList()
      ResetList(ObjectList())
      For shadow=0 To CountList(ObjectList()) - 1
        NextElement(ObjectList())
        If ObjectList()\IsLight=#False
          Select ObjectList()\Type
            Case #ObjectType_Sphere
              t.f=TestSphere(rayo,rayd,@ObjectList())
            Case #ObjectType_Plane
              t.f=TestPlane(rayo,rayd,@ObjectList())
            Case #ObjectType_Triangle
              t.f=TestTriangle(rayo,rayd,@ObjectList())
          EndSelect
          If t>0
            shade=0
            Break
          EndIf
        EndIf
      Next shadow
      ChangeCurrentElement(ObjectList(), *Old_Element2)
      If shade>0 ;because shadows aren't working
        If *Material\Diffuse > 0
          dot.f=Abs(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\Specular>0
            VectorScalarMuilply(*Normal,2*VectorDotProduct(Light,*Normal),tempvec)
            VectorSubtract(Light,tempvec,tempvec) ;r=light-2*dot(light,normal)*normal
            dot.f=VectorDotProduct(*Direction,tempvec)
            If dot>0
              spec.f=Pow(dot,20)**Material\Specular
              ColorScalarMuilply(ObjectList()\Material\SoildColor,spec,Color)
              ColorAdd(Color,*Accumalated,*Accumalated)
            EndIf
          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)
            ColorScalarMuilply(reflectcolor,*Material\Reflect,Color)
            ColorMuilply(Color,*Material\SoildColor,Color)
            ColorAdd(Color,*Accumalated,*Accumalated);Accumalated += MaterialReflect * reflectcolor * MaterialColor
          EndIf
        EndIf
      EndIf
    EndIf
  Next Object
  ChangeCurrentElement(ObjectList(), *Old_Element)
  ; Debug "Leaving Shade()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.f TestSphere(*Origin.xyz,*Direction.xyz,*Sphere.Object)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering TestSphere() With"+Hex(*Origin)+", "+Hex(*Direction)+", "+Hex(*Sphere)
  offset.xyz
  VectorSubtract(*Origin, *Sphere\Origin, offset)
  radius.f = PeekF(*Sphere\Primitive)
  b.f = 2 * VectorDotProduct(*Direction,offset)
  c.f = VectorDotProduct(offset,offset) - 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
  ; Debug "Leaving TestSphere() With"+StrF(t)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn t 
EndProcedure

Procedure.f TestPlane(*Origin.xyz,*Direction.xyz,*Plane.Object)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering TestPlane() With"+Hex(*Origin)+", "+Hex(*Direction)+", "+Hex(*Plane)
  Distance.f=PeekF(*Plane\Primitive)
  vd.f=VectorDotProduct(*Plane\Normal,*Direction)
  If vd<>0
    vo.f=-(VectorDotProduct(*Plane\Normal,*Origin)+Distance)
    t.f=vo/vd
    ; Debug "Leaving TestPlane() With"+StrF(t)
    ; etime.l=ElapsedMilliseconds()
    ; LastProcedureTime=etime-stime
    ProcedureReturn t
  EndIf
EndProcedure

Procedure.f TestTriangle(*Origin.xyz,*Direction.xyz,*Triangle.Object) ;incomplete
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering TestTriangle() With"+Hex(*Origin)+", "+Hex(*Direction)+", "+Hex(*Triangle)
  spana.xyz
  spanb.xyz
  vec.xyz
  len.f
  len2.f
  r.f
  s.f
  t.f
  triangle.Triangle
  
  mathtemp.xyz
  
  ; triangle\v1\x=PeekF(*Triangle\Primitive)
  ; triangle\v1\y=PeekF(*Triangle\Primitive+4)
  ; triangle\v1\z=PeekF(*Triangle\Primitive+8)
  ; triangle\v2\x=PeekF(*Triangle\Primitive+12)
  ; triangle\v2\y=PeekF(*Triangle\Primitive+16)
  ; triangle\v2\z=PeekF(*Triangle\Primitive+20)
  ; triangle\v3\x=PeekF(*Triangle\Primitive+24)
  ; triangle\v3\y=PeekF(*Triangle\Primitive+28)
  ; triangle\v3\z=PeekF(*Triangle\Primitive+32)
  ; ;triangle\Normal\x=PeekF(*Triangle\Primitive+36)
  ; ;triangle\Normal\y=PeekF(*Triangle\Primitive+40)
  ; ;triangle\Normal\z=PeekF(*Triangle\Primitive+44)
  ; 
  ; VectorSubtract(triangle\v2,triangle\v1,spana)
  ; VectorSubtract(triangle\v3,triangle\v1,spanb)
  ; ;triangle\Normal\x=spana\y*spanb\z-spana\z*spanb\y
  ; ;triangle\Normal\y=spana\z*spanb\x-spana\x*spanb\z
  ; ;triangle\Normal\z=spana\x*spanb\y-spana\y*spanb\x
  ; ;VectorCrossMuiltply(spana,spanb,triangle\Normal)
  ; len=VectorMagnitude(triangle\Normal)
  ; Debug "Leaving TestTriangle() With"+StrF(t)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure TraceRay(*Origin.xyz,*Direction.xyz,depth.b,*res.Color)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering TraceRay() With"+Hex(*Origin)+", "+Hex(*Direction)+", "+Str(depth)+", "+Hex(*res)
  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
        Case #ObjectType_Plane
          t.f=TestPlane(*Origin,*Direction,@ObjectList())
          If t>0
            If t<ClosestT Or ClosestT=-1
              Closesthandle=Object
              ClosestT=t
            EndIf
          EndIf
        Case #ObjectType_Triangle
          t.f=TestTriangle(*Origin,*Direction,@ObjectList())
          If t>0
            If t<ClosestT Or ClosestT=-1
              Closesthandle=Object
              ClosestT=t
            EndIf
          EndIf
      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
      Else
        Normal\x=ObjectList()\Normal\x
        Normal\y=ObjectList()\Normal\y
        Normal\z=ObjectList()\Normal\z
      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
  ; Debug "Leaving TraceRay()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure RenderScene(*Scene.Scene,*ViewPort.Camera)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering RenderScene() With"+Hex(*Scene)+", "+Hex(*ViewPort)
  Color.Color
  sx.f=-*Scene\HalfScreenWidth
  sy.f=-*Scene\HalfScreenHeight
  y.f=-*Scene\WorldScreenHalfHeight
  x.f=-*Scene\WorldScreenHalfWidth
  While y<*Scene\WorldScreenHalfHeight
    While x<*Scene\WorldScreenHalfWidth
      *ViewPort\Direction\x = x
      *ViewPort\Direction\y = -y
      *ViewPort\Direction\z = 0
      VectorSubtract(*ViewPort\Direction,*ViewPort\Origin,*ViewPort\Direction)
      VectorNormalize(*ViewPort\Direction)
      TraceRay(*ViewPort\Origin,*ViewPort\Direction,0,Color)
      ColorScalarMuilply(Color,256,Color)
      ColorRangeCheck(Color)
      If Color\Red<>0 Or Color\Green<>0 Or Color\Blue<>0
        Plot(*Scene\HalfScreenWidth + sx, *Scene\HalfScreenHeight + sy,RGB(Color\Red,Color\Green,Color\Blue))
      EndIf
      x+*Scene\PixelStep
      sx+1
    Wend
    x=-*Scene\WorldScreenHalfWidth
    sx=-*Scene\HalfScreenWidth
    y+*Scene\PixelStep
    sy+1
  Wend
  ; Debug "Leaving RenderScene()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure TestLoop() ;tester
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering TestLoop()"
  ;DefType.f
  Sphere1.Object
  Sphere1Radius.f
  Sphere2.Object
  Sphere2Radius.f
  Plane.Object
  PlaneDistance.f
  Light1.PointLight
  light2.PointLight
  MainCamera.Camera
  MainScene.Scene
  
  Sphere1\Origin\x=1
  Sphere1\Origin\y=-0.8
  Sphere1\Origin\z=3
  Sphere1\Material\SoildColor\Red=0.7
  Sphere1\Material\SoildColor\Green=0.7
  Sphere1\Material\SoildColor\Blue=0.7
  Sphere1\Material\Diffuse=1
  Sphere1\Material\Reflect=1
  Sphere1\Material\Refract=0
  Sphere1\Material\Specular=1
  Sphere1Radius=2.5
  
  AddSphereObject(Sphere1,Sphere1Radius)
  
  Sphere2\Origin\x=-5.5
  Sphere2\Origin\y=-0.5
  Sphere2\Origin\z=7
  Sphere2\Material\SoildColor\Red=0.7
  Sphere2\Material\SoildColor\Green=0.7
  Sphere2\Material\SoildColor\Blue=1
  Sphere2\Material\Diffuse=0.1
  Sphere2\Material\Reflect=1
  Sphere2\Material\Refract=0
  Sphere2\Material\Specular=1
  Sphere2Radius=2
  
  AddSphereObject(Sphere2,Sphere2Radius)
  
  Plane\Origin\x=0
  Plane\Origin\y=0
  Plane\Origin\z=0
  Plane\Material\SoildColor\Red=0.4
  Plane\Material\SoildColor\Green=0.3
  Plane\Material\SoildColor\Blue=0.3
  Plane\Material\Diffuse=1
  Plane\Material\Reflect=1
  Plane\Material\Refract=0
  Plane\Normal\x=0
  Plane\Normal\y=1
  Plane\Normal\z=0
  PlaneDistance=4.4
  
  AddPlaneObject(Plane,PlaneDistance)
  
  Light1\Origin\x=0
  Light1\Origin\y=-5
  Light1\Origin\z=5
  Light1\Color\Red=0.6
  Light1\Color\Green=0.6
  Light1\Color\Blue=0.6
  
  AddPointLightObject(Light1)
  
  light2\Origin\x=2
  light2\Origin\y=-5
  light2\Origin\z=1
  light2\Color\Red=0.7
  light2\Color\Green=0.7
  light2\Color\Blue=0.9
  
  AddPointLightObject(light2)
  
  MainCamera\Origin\x=0
  MainCamera\Origin\y=0
  MainCamera\Origin\z=-5
  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\WorldScreenWidth=8
  MainScene\WorldScreenHieght=6
  MainScene\WorldScreenHalfWidth=MainScene\WorldScreenWidth/2
  MainScene\WorldScreenHalfHeight=MainScene\WorldScreenHieght/2
  MainScene\ScreenWidth=800
  MainScene\ScreenHeight=600
  MainScene\HalfScreenWidth=MainScene\ScreenWidth/2
  MainScene\HalfScreenHeight=MainScene\ScreenHeight/2
  MainScene\PixelStep=0.01
  
  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(1)
    stop=ElapsedMilliseconds()
    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
  ; Debug "Leaving TestLoop()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

TestLoop()

Posted: Fri Jul 08, 2005 1:21 am
by Dreglor
here is some fixed code
with a added feature: Exposure Control :)
the code here is faster and a little more faster as i rewote the math so it is not using the procedures adds to the lenght of the code but makes it faster now it only slow ;) it takes 1.5 second to render a 800x600 window with everything casting shadows and reflections on my machine.
im am going to attempt adaptive subsampling.

and is here is a screen shot

Image

so here is some fully working code with shadows a phong shading :D do note that the exposure level even is 1 it makes the image slightly darker than what it really is so if you edit the exposure out it should almost identical to the image above from flipcode
also theres a few artifacts on the small sphere im not sure what that is i think its from the shadow code..

Code: Select all

;/Title: PBRay
;/Author: Dreglor
;/Date: 7-7-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
#ObjectType_Plane=3
#ObjectType_Triangle=4

#MaxChildren=6

#EPSILON=0.0001
#E=2.71828183

;- Structures

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

Structure VectorMatrix
  e1.f
  e2.f
  e3.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
  Apature.f ;exposure control
EndStructure

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

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

Structure PointLight
  Color.Color
  Origin.xyz
EndStructure

Structure Sphere
  radius.f
EndStructure

Structure Plane
  Distance.xyz
EndStructure

Structure Triangle
  v1.xyz
  v2.xyz
  v3.xyz
EndStructure

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

Structure Scene
  Ambient.Color
  WorldScreenSize.f
  WorldScreenWidth.f
  WorldScreenHieght.f
  WorldScreenHalfWidth.f
  WorldScreenHalfHeight.f
  ScreenWidth.w
  ScreenHeight.w
  HalfScreenWidth.w
  HalfScreenHeight.w
  PixelStep.f
  RealPixelsStep.w
EndStructure

;- Globals

Global MainScene.Scene
Global LastProcedur; etime.l

NewList ObjectList.Object()

;- Declares

Declare.l TestLoop();tester
Declare.b RenderScene(*Scene.Scene, *ViewPort.Camera)
Declare.l TraceRay(*Origin.xyz, *Direction.xyz, depth.b, *res.Color)
Declare.f TestSphere(*Origin.xyz, *Direction.xyz, *Sphere.Object)
Declare.f TestPlane(*Origin.xyz,*Direction.xyz,*Plane.Object)
Declare.f TestTriangle(*Origin.xyz,*Direction.xyz,*Triangle.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 AddTriangleObject(*Triangle.Object,*v1.xyz,*v2.xyz,*v3.xyz,*Normal.xyz)
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
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering ColorScalarMuilply() With "+Hex(*a)+", "+Str(b)+", "+Hex(*result)
  *result\Red = *a\Red * b
  *result\Green = *a\Green * b
  *result\Blue = *a\Blue * b
  ; Debug "Leaving ColorScalarMuilply()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b ColorMuilply(*a.Color, *b.Color, *result.Color);returns a pointer to a Color that has been muiltiplied
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering ColorMuilply() With "+Hex(*a)+", "+Hex(*b)+", "+Hex(*result)
  *result\Red = *a\Red * *b\Red
  *result\Green = *a\Green * *b\Green
  *result\Blue = *a\Blue * *b\Blue
  ; Debug "Leaving ColorMuilply()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b ColorAdd(*a.Color, *b.Color, *result.Color);returns a pointer to a Color that has been added
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering ColorAdd() With"+Hex(*a)+", "+Hex(*b)+", "+Hex(*result)
  *result\Red = *a\Red + *b\Red
  *result\Green = *a\Green + *b\Green
  *result\Blue = *a\Blue + *b\Blue
  ; Debug "Leaving ColorAdd()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure ColorRangeCheck(*a.Color)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering ColorRangeCheck() With"+Hex(*a)
  If *a\Red>255
    *a\Red=255
  EndIf
  If *a\Green>255
    *a\Green=255
  EndIf
  If *a\Blue>255
    *a\Blue=255
  EndIf
  If *a\Red<0
    *a\Red=0
  EndIf
  If *a\Green<0
    *a\Green=0
  EndIf
  If *a\Blue<0
    *a\Blue=0
  EndIf
  ; Debug "Leaving ColorRangeCheck()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

;-Vector Math

Procedure.f VectorMagnitude(*this.xyz);returns the maginitude of a Vector
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorMagnitude() With"+Hex(*this)
  result.f=Sqr(*this\x * *this\x+*this\y * *this\y+*this\z * *this\z)
  ; Debug "Leaving VectorMagnitude() With"+ StrF(result)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
EndProcedure

Procedure.f VectorDotProduct(*a.xyz, *b.xyz)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorDotProduct() With"+Hex(*a)+", "+Hex(*b)
  result.f=*a\x * *b\x + *a\y * *b\y + *a\z * *b\z
  ; Debug "Leaving VectorDotProduct() With"+StrF(result)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
EndProcedure

Procedure.b VectorNormalize(*this.xyz);normilzes a vector
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorNormalize() With"+Hex(*this)
  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
  ; Debug "Leaving VectorNormalize()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b VectorReverse(*this.xyz);reverses a Vector
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorReverse() With"+Hex(*this)
  *this\x = -*this\x
  *this\y = -*this\y
  *this\z = -*this\z
  ; Debug "Leaving VectorReverse()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b VectorCrossMuiltply(*a.xyz, *b.xyz, *result.xyz);returns a pointer to a vector that has been crossed muiltiplied
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorCrossMuiltply() With"+Hex(*a)+", "+Hex(*b)+", "+Hex(*result)
  *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
  ; Debug "Leaving VectorCrossMuiltply()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b VectorAdd(*a.xyz, *b.xyz, *result.xyz);returns a pointer to a vector that has been added
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorAdd() With"+Hex(*a)+", "+Hex(*b)+", "+Hex(*result)
  *result\x = *a\x + *b\x
  *result\y = *a\y + *b\y
  *result\z = *a\z + *b\z
  ; Debug "Leaving VectorAdd()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b VectorSubtract(*a.xyz, *b.xyz, *result.xyz);returns a pointer to a vector that has been Subtracted
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorSubtract() With"+Hex(*a)+", "+Hex(*b)+", "+Hex(*result)
  *result\x = *a\x - *b\x
  *result\y = *a\y - *b\y
  *result\z = *a\z - *b\z
  ; Debug "Leaving VectorSubtract()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b VectorScalarMuilply(*a.xyz, b.f, *result.xyz);returns a pointer to a vector that has been muiltiplied
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorScalarMuilply() With"+Hex(*a)+", "+Str(*b)+", "+Hex(*result)
  *result\x = *a\x * b
  *result\y = *a\y * b
  *result\z = *a\z * b
  ; Debug "Leaving VectorScalarMuilply()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b VectorScalarDivide(*a.xyz, b.f, *result.xyz);returns a pointer to a vector that has been divided
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorScalarDivide() With"+Hex(*a)+", "+Str(*b)+", "+Hex(*result)
  *result\x = *a\x / b
  *result\y = *a\y / b
  *result\z = *a\z / b
  ; Debug "Leaving VectorScalarDivide()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.f VectorTripleScalarProduct(*a.xyz, *b.xyz, *c.xyz);returns triple scalar product of 3 vectors
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering VectorTripleScalarProduct() With"+Hex(*a)+", "+Hex(*b)+", "+Hex(*c)
  result.f=*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))
  ; Debug "Leaving VectorTripleScalarProduct() With"+StrF(result)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
EndProcedure

;-Matrix Math

Procedure.f MatrixDeterminant(*this.Matrix);returns the determiant of a matrix
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering MatrixDeterminant() With"+Hex(*this)
  result.f=*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
  ; Debug "Leaving MatrixDeterminant() With"+StrF(result)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
EndProcedure

Procedure.w MatrixTranspose(*this.Matrix, *result.Matrix);returns the transpose of a matrix
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering MatrixTranspose() With"+Hex(*this)+", "+Hex(*result)
  *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
  ; Debug "Leaving MatrixTranspose()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.w MatrixInverse(*this.Matrix);returns the inverse of a matrix
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering MatrixInverse() With"+Hex(*this)
  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
  ; Debug "Leaving MatrixInverse()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.w MatrixAdd(*a.Matrix, *b.Matrix, *result.Matrix);adds 2 matrice together
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering MatrixAdd() With"+Hex(*a)+" ,"+Hex(*b)+" ,"+Hex(*result)
  *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
  ; Debug "Leaving MatrixAdd()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.w MatrixSubtract(*a.Matrix, *b.Matrix, *result.Matrix);subtract 2 matrice together
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering MatrixSubtract() With"+Hex(*a)+" ,"+Hex(*b)+" ,"+Hex(*result)
  *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
  ; Debug "Leaving MatrixSubtract()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.w MatrixScalarMuiltply(*a.Matrix, Scalar.f, *result.Matrix);muiltplies a matrix to a scalar
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering MatrixScalarMuiltply() With"+Hex(*a)+", "+StrF(Scalar)+", "+Hex(*result)
  *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
  ; Debug "Leaving MatrixScalarMuiltply()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.w MatrixScalarDivision(*a.Matrix, Scalar.f, *result.Matrix);divides a matrix to a scalar
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering MatrixScalarDivision() With"+Hex(*a)+", "+StrF(Scalar)+", "+Hex(*result)
  *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
  ; Debug "Leaving MatrixScalarDivision()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

;-FrameWork

Procedure AddPointLightObject(*Light.PointLight)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering AddPointLightObject() With"+Hex(*Light)
  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
  ; Debug "Leaving AddPointLightObject()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
  
EndProcedure

Procedure.b AddSphereObject(*Sphere.Object,radius.f)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering AddSphereObject() With"+Hex(*Sphere)+", "+StrF(radius)
  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
  ; Debug "Leaving AddSphereObject() With"+Hex(result)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
EndProcedure

Procedure AddPlaneObject(*Plane.Object,Distance.f)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering AddPlaneObject() With"+Hex(*Plane)+StrF(Distance)
  If CountList(ObjectList())>0
    *Old_Element = @ObjectList()
  EndIf
  AddElement(ObjectList())
  ;copy object data into the new object
  CopyMemory(*Plane,@ObjectList(),SizeOf(Object))
  ;put any primtive specific data into there places
  ObjectList()\Type=#ObjectType_Plane
  ObjectList()\Primitive=AllocateMemory(4)
  PokeF(ObjectList()\Primitive,Distance)
  result.l=@ObjectList()
  ; Debug "Leaving AddPlaneObject() With"+Hex(result)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
EndProcedure

Procedure.b AddTriangleObject(*Triangle.Object,*v1.xyz,*v2.xyz,*v3.xyz,*Normal.xyz)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering AddTriangleObject() With"+Hex(*Triangle)+", "+Hex(*v1)+", "+Hex(*v2)+", "+Hex(*v3)+", "+Hex(*Normal)
  If CountList(ObjectList())>0
    *Old_Element = @ObjectList()
  EndIf
  AddElement(ObjectList())
  ;copy object data into the new object
  CopyMemory(*Triangle,@ObjectList(),SizeOf(Object))
  ;put any primtive specific data into there places
  ObjectList()\Primitive=AllocateMemory(48)
  CopyMemory(*v1,ObjectList()\Primitive,12)
  CopyMemory(*v2,ObjectList()\Primitive+12,12)
  CopyMemory(*v3,ObjectList()\Primitive+24,12)
  CopyMemory(*Normal,ObjectList()\Primitive+36,12)
  ObjectList()\Type=#ObjectType_Triangle
  result.l=@ObjectList()
  If *Old_Element<>#Null
    ChangeCurrentElement(ObjectList(), *Old_Element)
  EndIf
  result.l=@ObjectList()
  ; Debug "Leaving AddTriangleObject() With"+Hex(result)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn result
EndProcedure

Procedure.b GetObjectStructure(ObjectPointer,*destination.Object)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering GetObjectStructure() With"+Hex(ObjectPointer)+", "+Hex(*destination)
  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
  ; Debug "Leaving GetObjectStructure()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b SetObjectStructure(ObjectPointer,*source.Object)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering SetObjectStructure() With"+Hex(ObjectPointer)+", "+Hex(*source)
  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
  ; Debug "Leaving SetObjectStructure()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.b RemoveObject(ObjectPointer)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering RemoveObject() With"+Hex(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
  ; Debug "Leaving RemoveObject()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure Shade(*Intersection.xyz,*Normal.xyz,*Direction.xyz,*Material.Material,depth.b,*Accumalated.Color)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering Shade() With"+Hex(*Intersection)+", "+Hex(*Normal)+", "+Hex(*Direction)+", "+Hex(*Material)+", "+Str(depth)+", "+Hex(*Accumalated)
  *Old_Element=@ObjectList()
  *result.Color
  Color.Color
  Light.xyz
  Relfection.xyz
  reflectcolor.Color
  ReflectOrigin.xyz
  tempvec.xyz
  l.xyz
  rayo.xyz
  rayd.xyz
  ResetList(ObjectList())
  For Object=0 To CountList(ObjectList()) - 1
    NextElement(ObjectList())
    If ObjectList()\IsLight=#True
      Light\x=ObjectList()\Origin\x-*Intersection\x
      Light\y=ObjectList()\Origin\y-*Intersection\y
      Light\z=ObjectList()\Origin\z-*Intersection\z
      
      VectorNormalize(Light)
      
      ;this shadow test only works with point light
      shade.f=1
      tdist.f=Sqr(Light\x * Light\x+Light\y * Light\y+Light\z * Light\z)
      
      l\x=Light\x/tdist
      l\y=Light\y/tdist
      l\z=Light\z/tdist
      
      rayo\x=*Intersection\x+l\x*#EPSILON
      rayo\y=*Intersection\y+l\y*#EPSILON
      rayo\z=*Intersection\z+l\z*#EPSILON
      
      rayd\x=l\x
      rayd\y=l\y
      rayd\z=l\z
      *Old_Element2=@ObjectList()
      ResetList(ObjectList())
      For shadow=0 To CountList(ObjectList()) - 1
        NextElement(ObjectList())
        If ObjectList()\IsLight=#False
          Select ObjectList()\Type
            Case #ObjectType_Sphere
              t.f=TestSphere(rayo,rayd,@ObjectList())
            Case #ObjectType_Plane
              t.f=TestPlane(rayo,rayd,@ObjectList())
            Case #ObjectType_Triangle
              t.f=TestTriangle(rayo,rayd,@ObjectList())
          EndSelect
          If t>0
            shade=0
            Break
          EndIf
        EndIf
      Next shadow
      ChangeCurrentElement(ObjectList(), *Old_Element2)
      If shade>0
        If *Material\Diffuse > 0
          dot.f=*Normal\x * Light\x + *Normal\y * Light\y + *Normal\z * Light\z
          If dot>0
            diff.f=dot * *Material\Diffuse
            
            *Accumalated\Red=*Accumalated\Red+diff**Material\SoildColor\Red*ObjectList()\Material\SoildColor\Red
            *Accumalated\Green=*Accumalated\Green+diff**Material\SoildColor\Green*ObjectList()\Material\SoildColor\Green
            *Accumalated\Blue=*Accumalated\Blue+diff**Material\SoildColor\Blue*ObjectList()\Material\SoildColor\Blue
          EndIf
          If *Material\Specular>0
            dot.f=*Normal\x * Light\x + *Normal\y * Light\y + *Normal\z * Light\z
            
            tempvec\x=Light\x-2*dot**Normal\x
            tempvec\y=Light\y-2*dot**Normal\y
            tempvec\z=Light\z-2*dot**Normal\z
            
            dot=*Direction\x * tempvec\x + *Direction\y * tempvec\y + *Direction\z * tempvec\z
            If dot>0
              spec.f=Pow(dot,20)**Material\Specular
              
              *Accumalated\Red=*Accumalated\Red+ObjectList()\Material\SoildColor\Red*spec
              *Accumalated\Green=*Accumalated\Green+ObjectList()\Material\SoildColor\Green*spec
              *Accumalated\Blue=*Accumalated\Blue+ObjectList()\Material\SoildColor\Blue*spec
            EndIf
          EndIf
          If *Material\Reflect>0
            r.f=*Direction\x * *Normal\x + *Direction\y * *Normal\y + *Direction\z * *Normal\z
            Relfection\x=*Direction\x-2*r**Normal\x
            Relfection\y=*Direction\y-2*r**Normal\y
            Relfection\z=*Direction\z-2*r**Normal\z
            
            ReflectOrigin\x=*Intersection\x+Relfection\x*#EPSILON
            ReflectOrigin\y=*Intersection\y+Relfection\y*#EPSILON
            ReflectOrigin\z=*Intersection\z+Relfection\z*#EPSILON
            
            TraceRay(ReflectOrigin,Relfection,depth+1,reflectcolor)
            
            *Accumalated\Red=*Accumalated\Red+*Material\Reflect*reflectcolor\Red**Material\SoildColor\Red
            *Accumalated\Green=*Accumalated\Green+*Material\Reflect*reflectcolor\Green**Material\SoildColor\Green
            *Accumalated\Blue=*Accumalated\Blue+*Material\Reflect*reflectcolor\Blue**Material\SoildColor\Blue
          EndIf
        EndIf
      EndIf
    EndIf
  Next Object
  ChangeCurrentElement(ObjectList(), *Old_Element)
  ; Debug "Leaving Shade()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure.f TestSphere(*Origin.xyz,*Direction.xyz,*Sphere.Object)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering TestSphere() With"+Hex(*Origin)+", "+Hex(*Direction)+", "+Hex(*Sphere)
  offset.xyz
  offset\x=*Origin\x-*Sphere\Origin\x
  offset\y=*Origin\y-*Sphere\Origin\y
  offset\z=*Origin\z-*Sphere\Origin\z
  ;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
  ; Debug "Leaving TestSphere() With"+StrF(t)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
  ProcedureReturn t
EndProcedure

Procedure.f TestPlane(*Origin.xyz,*Direction.xyz,*Plane.Object)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering TestPlane() With"+Hex(*Origin)+", "+Hex(*Direction)+", "+Hex(*Plane)
  Distance.f=PeekF(*Plane\Primitive)
  vd.f=*Plane\Normal\x * *Direction\x + *Plane\Normal\y * *Direction\y + *Plane\Normal\z * *Direction\z
  If vd<>0
    vo.f=-(VectorDotProduct(*Plane\Normal,*Origin)+Distance)
    t.f=vo/vd
    ; Debug "Leaving TestPlane() With"+StrF(t)
    ; etime.l=ElapsedMilliseconds()
    ; LastProcedureTime=etime-stime
    ProcedureReturn t
  EndIf
EndProcedure

Procedure.f TestTriangle(*Origin.xyz,*Direction.xyz,*Triangle.Object) ;incomplete
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering TestTriangle() With"+Hex(*Origin)+", "+Hex(*Direction)+", "+Hex(*Triangle)
  spana.xyz
  spanb.xyz
  vec.xyz
  len.f
  len2.f
  r.f
  s.f
  t.f
  triangle.Triangle
  
  mathtemp.xyz
  
  ; triangle\v1\x=PeekF(*Triangle\Primitive)
  ; triangle\v1\y=PeekF(*Triangle\Primitive+4)
  ; triangle\v1\z=PeekF(*Triangle\Primitive+8)
  ; triangle\v2\x=PeekF(*Triangle\Primitive+12)
  ; triangle\v2\y=PeekF(*Triangle\Primitive+16)
  ; triangle\v2\z=PeekF(*Triangle\Primitive+20)
  ; triangle\v3\x=PeekF(*Triangle\Primitive+24)
  ; triangle\v3\y=PeekF(*Triangle\Primitive+28)
  ; triangle\v3\z=PeekF(*Triangle\Primitive+32)
  ; ;triangle\Normal\x=PeekF(*Triangle\Primitive+36)
  ; ;triangle\Normal\y=PeekF(*Triangle\Primitive+40)
  ; ;triangle\Normal\z=PeekF(*Triangle\Primitive+44)
  ;
  ; VectorSubtract(triangle\v2,triangle\v1,spana)
  ; VectorSubtract(triangle\v3,triangle\v1,spanb)
  ; ;triangle\Normal\x=spana\y*spanb\z-spana\z*spanb\y
  ; ;triangle\Normal\y=spana\z*spanb\x-spana\x*spanb\z
  ; ;triangle\Normal\z=spana\x*spanb\y-spana\y*spanb\x
  ; ;VectorCrossMuiltply(spana,spanb,triangle\Normal)
  ; len=VectorMagnitude(triangle\Normal)
  ; Debug "Leaving TestTriangle() With"+StrF(t)
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure TraceRay(*Origin.xyz,*Direction.xyz,depth.b,*res.Color)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering TraceRay() With"+Hex(*Origin)+", "+Hex(*Direction)+", "+Str(depth)+", "+Hex(*res)
  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
        Case #ObjectType_Plane
          t.f=TestPlane(*Origin,*Direction,@ObjectList())
          If t>0
            If t<ClosestT Or ClosestT=-1
              Closesthandle=Object
              ClosestT=t
            EndIf
          EndIf
        Case #ObjectType_Triangle
          t.f=TestTriangle(*Origin,*Direction,@ObjectList())
          If t>0
            If t<ClosestT Or ClosestT=-1
              Closesthandle=Object
              ClosestT=t
            EndIf
          EndIf
      EndSelect
    Next Object
    If ClosestT>0
      t=ClosestT
      SelectElement(ObjectList(),Closesthandle)
      Intersection\x=*Origin\x+*Direction\x*t
      Intersection\y=*Origin\y+*Direction\y*t
      Intersection\z=*Origin\z+*Direction\z*t;Calulate Interesction point with
      If ObjectList()\Type=#ObjectType_Sphere ;normal Calulations are diffrent per object
        radius.f=PeekF(ObjectList()\Primitive)
        Normal\x=(Intersection-ObjectList()\Origin)/radius
        Normal\y=(Intersection-ObjectList()\Origin)/radius
        Normal\z=(Intersection-ObjectList()\Origin)/radius
        VectorSubtract(Intersection ,ObjectList()\Origin,Normal)
        VectorScalarDivide(Normal,PeekF(ObjectList()\Primitive),Normal)
        ;other cases will be added
      Else
        Normal\x=ObjectList()\Normal\x
        Normal\y=ObjectList()\Normal\y
        Normal\z=ObjectList()\Normal\z
      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
  ; Debug "Leaving TraceRay()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure RenderScene(*Scene.Scene,*ViewPort.Camera)
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering RenderScene() With"+Hex(*Scene)+", "+Hex(*ViewPort)
  Color.Color
  sx.f=-*Scene\HalfScreenWidth
  sy.f=-*Scene\HalfScreenHeight
  y.f=-*Scene\WorldScreenHalfHeight
  x.f=-*Scene\WorldScreenHalfWidth
  *ViewPort\Apature+0.01
  While y<*Scene\WorldScreenHalfHeight
    While x<*Scene\WorldScreenHalfWidth
      *ViewPort\Direction\x = x-*ViewPort\Origin\x
      *ViewPort\Direction\y = -y-*ViewPort\Origin\y
      *ViewPort\Direction\z = -*ViewPort\Origin\z
      VectorNormalize(*ViewPort\Direction)
      TraceRay(*ViewPort\Origin,*ViewPort\Direction,0,Color)
      Light.f=(Color\Red + Color\Green + Color\Blue)*0.33333333
      expose.f=(1-Pow(#E,-(Light**ViewPort\Apature)))*255
      Color\Red=Color\Red*expose
      Color\Green=Color\Green*expose
      Color\Blue=Color\Blue*expose
      ColorRangeCheck(Color)
      If Color\Red<>0 Or Color\Green<>0 Or Color\Blue<>0
        Plot(*Scene\HalfScreenWidth + sx, *Scene\HalfScreenHeight + sy,RGB(Color\Red,Color\Green,Color\Blue))
      EndIf
      x+*Scene\PixelStep
      sx+*Scene\RealPixelsStep
    Wend
    x=-*Scene\WorldScreenHalfWidth
    sx=-*Scene\HalfScreenWidth
    y+*Scene\PixelStep
    sy+*Scene\RealPixelsStep
  Wend
  ; Debug "Leaving RenderScene()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

Procedure TestLoop() ;tester
  ; stime.l=ElapsedMilliseconds()
  ; Debug "Entering TestLoop()"
  ;DefType.f
  Sphere1.Object
  Sphere1Radius.f
  Sphere2.Object
  Sphere2Radius.f
  Plane.Object
  PlaneDistance.f
  Light1.PointLight
  light2.PointLight
  MainCamera.Camera
  MainScene.Scene
  
  Sphere1\Origin\x=1
  Sphere1\Origin\y=-0.8
  Sphere1\Origin\z=3
  Sphere1\Material\SoildColor\Red=0.7
  Sphere1\Material\SoildColor\Green=0.7
  Sphere1\Material\SoildColor\Blue=0.7
  Sphere1\Material\Diffuse=1
  Sphere1\Material\Reflect=1
  Sphere1\Material\Refract=0
  Sphere1\Material\Specular=1
  Sphere1Radius=2.5
  
  AddSphereObject(Sphere1,Sphere1Radius)
  
  Sphere2\Origin\x=-5.5
  Sphere2\Origin\y=-0.5
  Sphere2\Origin\z=7
  Sphere2\Material\SoildColor\Red=0.7
  Sphere2\Material\SoildColor\Green=0.7
  Sphere2\Material\SoildColor\Blue=1
  Sphere2\Material\Diffuse=0.1
  Sphere2\Material\Reflect=1
  Sphere2\Material\Refract=0
  Sphere2\Material\Specular=1
  Sphere2Radius=2
  
  AddSphereObject(Sphere2,Sphere2Radius)
  
  Plane\Origin\x=0
  Plane\Origin\y=0
  Plane\Origin\z=0
  Plane\Material\SoildColor\Red=0.4
  Plane\Material\SoildColor\Green=0.3
  Plane\Material\SoildColor\Blue=0.3
  Plane\Material\Diffuse=1
  Plane\Material\Reflect=1
  Plane\Material\Refract=0
  Plane\Normal\x=0
  Plane\Normal\y=1
  Plane\Normal\z=0
  PlaneDistance=4.4
  
  AddPlaneObject(Plane,PlaneDistance)
  
  Light1\Origin\x=0
  Light1\Origin\y=5
  Light1\Origin\z=5
  Light1\Color\Red=0.6
  Light1\Color\Green=0.6
  Light1\Color\Blue=0.6
  
  AddPointLightObject(Light1)
  
  light2\Origin\x=2
  light2\Origin\y=5
  light2\Origin\z=1
  light2\Color\Red=0.7
  light2\Color\Green=0.7
  light2\Color\Blue=0.9
  
  AddPointLightObject(light2)
  
  MainCamera\Origin\x=0
  MainCamera\Origin\y=0
  MainCamera\Origin\z=-5
  MainCamera\ViewingAngle\x=0
  MainCamera\ViewingAngle\y=0
  MainCamera\ViewingAngle\z=0
  MainCamera\Apature=1
  
  ; MainScene\Ambient\Red=0.125
  ; MainScene\Ambient\Green=0.125 ;not active
  ; MainScene\Ambient\Blue=0.125
  MainScene\WorldScreenWidth=8
  MainScene\WorldScreenHieght=6
  MainScene\WorldScreenHalfWidth=MainScene\WorldScreenWidth/2
  MainScene\WorldScreenHalfHeight=MainScene\WorldScreenHieght/2
  MainScene\ScreenWidth=800
  MainScene\ScreenHeight=600
  MainScene\HalfScreenWidth=MainScene\ScreenWidth/2
  MainScene\HalfScreenHeight=MainScene\ScreenHeight/2
  MainScene\PixelStep=0.01
  MainScene\RealPixelsStep=1
  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(1)
    stop=ElapsedMilliseconds()
    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
  ; Debug "Leaving TestLoop()"
  ; etime.l=ElapsedMilliseconds()
  ; LastProcedureTime=etime-stime
EndProcedure

TestLoop()
edit: changed the exposer control so it was faster and more accurate

Posted: Fri Jul 08, 2005 1:56 am
by MrMat
Wow that looks amazing. Nice one :D

Posted: Fri Jul 08, 2005 8:41 am
by Rings
be sure that you don't plot outside the screen-range, else
an error will occur.
All versions are failed here with this error.So i put a check before
the Plot-Command to check that the X/Y Position is valid.

Posted: Sun Jul 10, 2005 12:54 pm
by Marcel
Hi.
Did you try the "Optimizer"?

http://www.purearea.net/pb/showcase/sho ... ca089d375c

Maybe that save some time!

Thx for understanding my real bad english! :D

Posted: Mon Jul 11, 2005 1:30 am
by Dreglor
thanks for the link

hmm im not getting much out of it only like 100ms

but i think becasue alot of my math is already opimtized

here is a small update

Im Currently working on Refractions (has some funky bugs)
i fix some bugs such as the shadows, the outside pixel drawing
i added a simple Stepping Adaptive subsample it does speed it up a bit but the quality is crap
I did alot of opmitzations which cut render times by more than half

the refractions right now are very bugged they are causing it to totally refract and reflect inside the sphere :O
resulting in 40 second render times and a totally white sphere!

Posted: Mon Jul 11, 2005 8:37 am
by Dreglor
well heres a nightly snapshot for you guys
a fewnotes on the code, its a mess particularly the traceray procedure i merged shade into and it does increase speed that and it becomes overkill when im passing like 10 arguments to it
refractions are not working still but i think its a problem with logic and not math so if some one can point it out and fix that would save me my hair ;)
I added a progressive render so you can see what it going to look like before it 100% very handy for testing and see somthing real quick so you don't have to wait until the entire thing is done rendering to see

the current scene in place is a bench mark type scene it has over 70 objects in it and takes an amazing 16 seconds to render it
if you want something lighter switch the uncomment the scene code below it and comment out the benchmark objects

also I rendered the benchmark scene with all of the objects perfectly reflective and it produced and intresting image showing me the limits of pb's floats and the accuracy problems that show up due tp this

the image pretty much explains everything :P

Image

to easy the pain of scrolling im uploading the pb file ;)

check it out, and feel free to add, fix, optmize my code it will help me alot!
Nightly.pb

Posted: Mon Jul 18, 2005 7:15 am
by Hades
Hi Dreglor, nice work ! :D

Some thoughts about optimization.

You could ...

- store the pointer to the intersection Procedure of a primitive inside the primitive's structure. That way you get rid of that If ElseIf EndIf and just write
t.f=CallFunctionFast(ObjectList()\Intersect, *Origin,*Direction,@ObjectList())
It's faster and looks nicer.

- do first hit optimization. For example in your TestSphere code c.f is constant per frame. You could store in inside the Object's structure.

- special case axis aligned planes and faces. For static Objects you could do that at creation time. For dynamic Objects per frame.

- replace Plot / Box with something fast. :)

- ...

But the only thing that gives you a real speed boost is a data structure that helps to minimize intersection tests.
If done right, for complex scenes (some million tris) a raytracer is FASTER than rasterizing hardware. :shock:

cu

Posted: Mon Jul 18, 2005 9:55 am
by Dreglor
those would be very helpful, right now the raytracer it on back burner becasue of the refraction problem i was getting very frustrated at it and i wasn't going anywere so i decided to work on somthing else until

as for project it self im going to attempt at getting the refraction working, eventually then get kd-tree stuff (axis aligned bsp tree) working and really focus on triangles

after that im thinking of really reworking the code to remove stuff that was never used and remove all primitives execpt for triangles spheres and planes aren't very useful and theres a good part devoted to this frame work and would be easier to manage if there was only one type and it would be faster

once i get a axis aligned bsp tree and trinagles only i might be able to get some sort of frame rate above 1fps heh

i think the biggest part that makes it alot faster is the subsampling and not having to trace pixels in certain areas, subsampling isn't getting very far on my list becasue i honstly can't much on it