Hi :)
I have find this topic on a purebasic forum :)
http://forums.purebasic.com/english/viewtopic.php?t=15568&postdays=0&postorder=asc&start=45
A guy have made a little raytracer in purebasic :)
I'm thinking ? it is possible to do the same think in bmax ? i'm trying
to understand the code but this couragous guy use pointer everywhere ! lol
I find it funny to do the same with bmax :) here is some couragous man in bmax :) ?
I have find this topic on a purebasic forum :)
http://forums.purebasic.com/english/viewtopic.php?t=15568&postdays=0&postorder=asc&start=45
A guy have made a little raytracer in purebasic :)
I'm thinking ? it is possible to do the same think in bmax ? i'm trying
to understand the code but this couragous guy use pointer everywhere ! lol
;/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 *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 If *a\Red<0 *a\Red=0 EndIf If *a\Green<0 *a\Green=0 EndIf If *a\Blue<0 *a\Blue=0 EndIf EndProcedure ;-Vector Math Procedure.f VectorMagnitude(*this.xyz);returns the maginitude of a Vector result.f=Sqr(*this\x * *this\x+*this\y * *this\y+*this\z * *this\z) ProcedureReturn result EndProcedure Procedure.f VectorDotProduct(*a.xyz, *b.xyz) result.f=*a\x * *b\x + *a\y * *b\y + *a\z * *b\z ProcedureReturn result 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 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)) ProcedureReturn result EndProcedure Procedure.f MatrixDeterminant(*this.Matrix);returns the determiant of a matrix 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 ProcedureReturn result 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\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 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 AddPlaneObject(*Plane.Object,Distance.f) 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() ProcedureReturn result EndProcedure Procedure.b AddTriangleObject(*Triangle.Object,*v1.xyz,*v2.xyz,*v3.xyz,*Normal.xyz) 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() 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 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) EndProcedure Procedure.f TestSphere(*Origin.xyz,*Direction.xyz,*Sphere.Object) offset.xyz offset\x=*Origin\x-*Sphere\Origin\x offset\y=*Origin\y-*Sphere\Origin\y offset\z=*Origin\z-*Sphere\Origin\z 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.f TestPlane(*Origin.xyz,*Direction.xyz,*Plane.Object) 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 ProcedureReturn t EndIf EndProcedure Procedure.f TestTriangle(*Origin.xyz,*Direction.xyz,*Triangle.Object) ;incomplete spana.xyz spanb.xyz vec.xyz len.f len2.f r.f s.f t.f triangle.Triangle mathtemp.xyz 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 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 EndProcedure Procedure RenderScene(*Scene.Scene,*ViewPort.Camera) 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-1 While x<*Scene\WorldScreenHalfWidth-1 *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 EndProcedure Procedure TestLoop() ;tester 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=2 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=1.7 light2\Color\Green=0.7 light2\Color\Blue=0.9 AddPointLightObject(light2) MainCamera\Origin\x=0 MainCamera\Origin\y=0 MainCamera\Origin\z=-2 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=8 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.02 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 EndProcedure TestLoop()
I find it funny to do the same with bmax :) here is some couragous man in bmax :) ?