Ray Tracer

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
UEZ
Posts: 848
Joined: May 05, 2017 19:59
Location: Germany

Ray Tracer

Post by UEZ »

I've converted the very cool JavaScript code from here to FB: "pure js ray tracer" by Igor Sbitnev

It took me awhile to understand the JS code but here the result:

Code: Select all

'Ported from https://js1k.com/2017-magic/demo/2648 by Igor Sbitnev To FB by UEZ build 2021-01-19

#Include "crt/math.bi"
#Include "fbgfx.bi"
Using FB
Randomize

Type Vector3D
	As Single x, y, z
End Type

Type tSpheresData
	As Vector3D position, color
	As Single radius
End Type

Type tIntersect
	As Integer intersection
	As Vector3D rayEnd, lightDirection, normal, sphereColor
End Type

Function Vector(x As Single, y As Single, z As Single) As Vector3D
	Return Type(x, y, z)
End Function

Const INTERSECTION_NONE = 0, INTERSECTION_SPHERE = 1, INTERSECTION_FLOOR = 2
Dim Shared As Vector3D CENTER_TILE_COLOR, OTHERS_TILE_COLOR, COLOR_SKY, COLOR_LIGHT_SOURCE, COLOR_STARS
CENTER_TILE_COLOR 	= Vector(8, 0, 8)
OTHERS_TILE_COLOR 	= Vector(8, 5, 8)
COLOR_SKY 		  	= Vector(5, 6, 8)
COLOR_LIGHT_SOURCE 	= Vector(8, 8, 8)
COLOR_STARS 		= Vector(8, 8, 8)

Dim Shared As tSpheresData spheresData(5)
spheresData(0).position	= Vector(10, 2, 2)
spheresData(0).color 	= Vector(4, 0, 4)
spheresData(0).radius 	= 1.5
spheresData(1).position = Vector(-3, 0, 2)
spheresData(1).color 	= Vector(8, 5, 7)
spheresData(1).radius 	= 1.5
spheresData(2).position = Vector(3, 0, 2)
spheresData(2).color 	= Vector(0, 0, 4)
spheresData(2).radius 	= 1.5
spheresData(3).position = Vector(1.5, 0, 4.5)
spheresData(3).color 	= Vector(8, 8, 6)
spheresData(3).radius 	= 1.5
spheresData(4).position = Vector(-1, 10, 4)
spheresData(4).color 	= Vector(0, 4, 4)
spheresData(4).radius 	= 4.0
spheresData(5).position = Vector(0, 0, 7)
spheresData(5).color 	= Vector(8, 5, 4)
spheresData(5).radius 	= 1.5

Function Sum(first As Vector3D, second As Vector3D) As Vector3D
	Return Type(first.x + second.x, first.y + second.y, first.z + second.z)
End Function

Function Scale(v As Vector3D, factor As Single) As Vector3D
	Return Type(v.x * factor, v.y * factor, v.z * factor)
End Function

Function dotProduct(first As Vector3D, second As Vector3D) As Single
	Return first.x * second.x + first.y * second.y + first.z * second.z
End Function

Function crossProduct(first As Vector3D, second As Vector3D) As Vector3D
	Return Type(first.y * second.z - first.z * second.y, first.z * second.x - first.x * second.z, first.x * second.y - first.y * second.x)
End Function

Function normalize(v As Vector3D) As Vector3D
	Return scale(v, 1 / Sqr(dotProduct(v, v)))
End Function

Function subtract(first As Vector3D, second As Vector3D) As Vector3D
	Return sum(first, scale(second, -1))
End Function

Function trace(rayStart As Vector3D, rayDirection As Vector3D) As tIntersect
	Dim As Vector3D rayEnd, lightDirection, normal, sphereColor, distanceToSphereCenter, lightPosition = Vector(Rnd() * 27, -81 + Rnd() * 27, 81)
	Dim As Integer i, intersection = INTERSECTION_NONE
	Dim As Single distanceToFloor = -rayStart.z / rayDirection.z, a = 1, b, c, d, distanceToSphere
	Dim As Ulongint distanceToNearestSphere = -1
	If distanceToFloor > 0 And rayStart.z > 0 Then
		intersection = INTERSECTION_FLOOR
		rayEnd = sum(rayStart, scale(rayDirection, distanceToFloor))
		lightDirection = normalize(subtract(lightPosition, rayEnd))
		normal = Vector(0, 0, 1)
	End If
	For i = 0 To Ubound(spheresData)
		distanceToSphereCenter = subtract(rayStart, spheresData(i).position)
		'a = 1 'dotProduct(rayDirection, rayDirection)
		b = 2 * dotProduct(rayDirection, distanceToSphereCenter)
		c = dotProduct(distanceToSphereCenter, distanceToSphereCenter) - spheresData(i).radius * spheresData(i).radius
		d = b * b - 4 * a * c
		distanceToSphere = (-b - Sqr(d)) / 2 * a
		If (distanceToSphere < distanceToNearestSphere) And (distanceToSphere > 0) Then
			distanceToNearestSphere = distanceToSphere
			intersection = INTERSECTION_SPHERE
			sphereColor = spheresData(i).color
			rayEnd = sum(rayStart, scale(rayDirection, distanceToSphere))
			lightDirection = normalize(subtract(lightPosition, rayEnd))
			normal = normalize(subtract(rayEnd, spheresData(i).position))
		End If
	Next
	Return Type(intersection, rayEnd, lightDirection, normal, sphereColor)
End Function

Function getFloorColor(x As Integer, y As Integer) As Vector3D
	If x + y <> 0 Then
		If fmod(x, 3) = 1 And fmod(y, 3) = 1 Then Return CENTER_TILE_COLOR
		Return getFloorColor((x \ 3), (y \ 3))
	End If
	Return OTHERS_TILE_COLOR
End Function

Function sample(rayStart As Vector3D, rayDirection As Vector3D, renderStars As Boolean = False) As Vector3D
	Dim As tIntersect ti = trace(rayStart, rayDirection)
	Dim As Vector3D reflectionRayDirection, color_, diffuse, specular, reflection, floorColor, uVector, vVector, randomizedDirection
	Select Case ti.intersection
		Case INTERSECTION_NONE
			Return Iif(renderStars And Rnd() > 0.9, COLOR_STARS, scale(COLOR_SKY, Pow(1 - rayDirection.z, 4)))
		Case INTERSECTION_SPHERE
			diffuse = scale(ti.sphereColor, 0.7 * dotProduct(ti.normal, ti.lightDirection))
			specular = scale(COLOR_LIGHT_SOURCE, Pow(dotProduct(ti.normal, normalize(subtract(ti.lightDirection, rayDirection))), 64))
			reflectionRayDirection = sum(rayDirection, scale(ti.normal, -2 * dotProduct(ti.normal, rayDirection)))
			reflection = scale(sample(ti.rayEnd, reflectionRayDirection), 0.4)
			color_ = sum(diffuse, sum(specular, reflection))
		Case INTERSECTION_FLOOR
			reflectionRayDirection = sum(rayDirection, scale(ti.normal, -2 * dotProduct(ti.normal, rayDirection)))
			floorColor = getFloorColor(CInt(fmod((ti.rayEnd.x + 81) * 27, 81)), CInt(fmod((ti.rayEnd.y + 81) * 27, 81)))
			uVector = crossProduct(rayDirection, reflectionRayDirection)
			vVector = crossProduct(uVector, reflectionRayDirection)
			randomizedDirection = sum(reflectionRayDirection, sum(scale(uVector, (Rnd() - 0.5) / 3), scale(vVector, (Rnd() - 0.5) / 3)))
			color_ = sum(floorColor, sample(ti.rayEnd, randomizedDirection))
			color_ = scale(color_, 0.5)
	End Select
	Dim As Integer isShadowed = trace(ti.rayEnd, ti.lightDirection).intersection
	Return scale(color_, Iif(isShadowed, 0.5, 1))
End Function

Randomize
Dim Shared As Integer iW, iW2, iH, iH2, i, j, pixel = 0, CANVAS_WIDTH, CANVAS_HEIGHT
iW = 512 : iH = 512
CANVAS_WIDTH = iW : CANVAS_HEIGHT = iH

#Define PutPixel(_x, _y, colour)   *Cptr(Ulong Ptr, pScrn + (_y) * pitch + (_x) Shl 2) = (colour)
#Define GetPixel(_x, _y)           *Cptr(Ulong Ptr, pScrn + (_y) * pitch + (_x) Shl 2)

Dim Shared As Any Ptr pScrn
Dim Shared As Integer pitch

#Define Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))
#Define Map(Val, source_start, source_stop, dest_start, dest_stop)   ((Val - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start)

Screenres iW, iH, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH
Screenset 1, 0

pScrn = Screenptr()
Screeninfo ,,,, pitch

Const RAYS_PER_PIXEL = 32, DISTANCE_TO_VIEWPORT = 10, VIEWPORT_WIDTH = 12, VIEWPORT_HEIGHT = 12, ALPHA_CHANNEL_COLOR = 255
Dim As Vector3D UP_DIRECTION = Vector(0, 0, 1), camera = Vector(-7, -10, 8), target = Vector(0, 0, 4), normalToViewport = normalize(subtract(camera, target)), _
	   uVector = normalize(crossProduct(UP_DIRECTION, normalToViewport)), vVector = crossProduct(uVector, normalToViewport), viewportCenter = sum(camera, scale(normalToViewport, -DISTANCE_TO_VIEWPORT)), _
	   leftDown = sum(viewportCenter, sum(scale(uVector, -VIEWPORT_WIDTH / 2), scale(vVector, -VIEWPORT_HEIGHT / 2))), colorSum, rayStart, viewportPixel, direction, color_
Dim As Ulong line_ = 0, b = 0

Dim As Double t = Timer
Do
	If line_ < iH Then
		For i = iW - 1 To 0 Step -1
			colorSum = Vector(0, 0, 0)
			For j = 0 To RAYS_PER_PIXEL - 1
				rayStart = sum(camera, sum(scale(uVector, (Rnd() - 0.5) / 3), scale(vVector, (Rnd() - 0.5) / 3)))
				viewportPixel = sum(leftDown, sum(scale(uVector, i * VIEWPORT_WIDTH / CANVAS_WIDTH), scale(vVector, line_ * VIEWPORT_HEIGHT / CANVAS_HEIGHT)))
				direction = normalize(subtract(viewportPixel, rayStart))
				color_ = sample(rayStart, direction, True)
				colorSum = sum(colorSum, color_)
			Next		
			PutPixel(i, line_, Rgba(Max(0, Min(255, colorSum.x)), Max(0, Min(255, colorSum.y)), Max(0, Min(255, colorSum.z)), ALPHA_CHANNEL_COLOR))
		Next
		line_ += 1
	Else
		If b = 0 Then Windowtitle("Ray Tracer / Rendered in " & Timer - t & " seconds") : b = 1
	Endif
	Flip
	Sleep(1)
Loop Until Len(Inkey())
Image


For more details have a look here: https://js1k.com/2017-magic/details/2648
Last edited by UEZ on Jan 19, 2021 18:26, edited 1 time in total.
angros47
Posts: 2126
Joined: Jun 21, 2005 19:04

Re: Ray Tracer

Post by angros47 »

I tried compiling your code back to JavaScript using the Emscripten version of FreeBasic:

https://raytracing.tiiny.site/

It not only works, but it also seems to be faster than the original JavaScript code
UEZ
Posts: 848
Joined: May 05, 2017 19:59
Location: Germany

Re: Ray Tracer

Post by UEZ »

angros47 wrote:I tried compiling your code back to JavaScript using the Emscripten version of FreeBasic
I "heard" about Emscripten here in this forum only. I never used it but sounds interesting.
Luxan
Posts: 165
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: Ray Tracer

Post by Luxan »

I had to dim pitch as Long , then your code compiled flawlessly.

About 21 seconds to render on my computer.
I don't think multi threading is in use .
D.J.Peters
Posts: 8575
Joined: May 28, 2005 3:28
Contact:

Re: Ray Tracer

Post by D.J.Peters »

On an old single core laptop I got 28 seconds a little bit slow
so I optimized the trace() function and the pixel plotting I get 14 seconds now :-)

Joshy

Code: Select all

'Ported from https://js1k.com/2017-magic/demo/2648 by Igor Sbitnev To FB by UEZ build 2021-01-19

' original on old laptop ~28 seconds optimized ~14 seconds

#Include "crt/math.bi"
#Include "fbgfx.bi"
Using FB
Randomize

#ifndef __FB_64BIT__
 type real as single
#else 
 type real as double
#endif

Type Vector3D
  As real x, y, z
End Type

Type tSpheresData
   As Vector3D position, color
   As real radius
End Type

Type tIntersect
   As Integer intersection
   As Vector3D rayEnd, lightDirection, normal, sphereColor
End Type

#define vector(_x,_y,_z) Type<vector3d>(_x, _y, _z)

Const INTERSECTION_NONE = 0, INTERSECTION_SPHERE = 1, INTERSECTION_FLOOR = 2
Dim Shared As Vector3D CENTER_TILE_COLOR, OTHERS_TILE_COLOR, COLOR_SKY, COLOR_LIGHT_SOURCE, COLOR_STARS
CENTER_TILE_COLOR    = Vector(8, 0, 8)
OTHERS_TILE_COLOR    = Vector(8, 5, 8)
COLOR_SKY            = Vector(5, 6, 8)
COLOR_LIGHT_SOURCE   = Vector(8, 8, 8)
COLOR_STARS          = Vector(4, 4, 8)

Dim Shared As tSpheresData spheresData(5)
spheresData(0).position = Vector(10, 2, 2)
spheresData(0).color    = Vector(4, 0, 4)
spheresData(0).radius   = 1.5
spheresData(1).position = Vector(-3, 0, 2)
spheresData(1).color    = Vector(8, 5, 7)
spheresData(1).radius   = 1.5
spheresData(2).position = Vector(3, 0, 2)
spheresData(2).color    = Vector(0, 0, 4)
spheresData(2).radius   = 1.5
spheresData(3).position = Vector(1.5, 0, 4.5)
spheresData(3).color    = Vector(8, 8, 6)
spheresData(3).radius   = 1.5
spheresData(4).position = Vector(-1, 10, 4)
spheresData(4).color    = Vector(0, 4, 4)
spheresData(4).radius   = 4.0
spheresData(5).position = Vector(0, 0, 7)
spheresData(5).color    = Vector(8, 5, 4)
spheresData(5).radius   = 1.5

Function Sum(first As Vector3D, second As Vector3D) As Vector3D
   Return Type(first.x + second.x, first.y + second.y, first.z + second.z)
End Function
Function subtract(first As Vector3D, second As Vector3D) As Vector3D
   Return Type(first.x - second.x, first.y - second.y, first.z - second.z)
End Function

Function Scale(v As Vector3D, factor As real) As Vector3D
   Return Type(v.x * factor, v.y * factor, v.z * factor)
End Function

Function dotProduct(first As Vector3D, second As Vector3D) As real
   Return first.x * second.x + first.y * second.y + first.z * second.z
End Function

Function crossProduct(first As Vector3D, second As Vector3D) As Vector3D
   Return Type(first.y * second.z - first.z * second.y, _
               first.z * second.x - first.x * second.z, _
               first.x * second.y - first.y * second.x)
End Function

Function normalize(v As Vector3D) As Vector3D
   Return scale(v, 1 / Sqr(dotProduct(v, v)))
End Function

Function trace(rayStart As Vector3D, rayDirection As Vector3D) As tIntersect
   Dim As Vector3D rayEnd=any
   Dim As Vector3D lightDirection=any
   Dim As Vector3D normal=any
   Dim As Vector3D sphereColor=any
   Dim As Vector3D distanceToSphereCenter=any
   Dim As Vector3D lightPosition = Vector(Rnd() * 27, -81 + Rnd() * 27, 81)
   Dim As Integer i=any, intersection = INTERSECTION_NONE
   dim as real b=any, c=any, d=any, distanceToSphere=any
   Dim As real distanceToFloor = -rayStart.z / rayDirection.z
   Dim As real distanceToNearestSphere = 2^31
   dim as integer sphereIndex=-1
   If distanceToFloor > 0 And rayStart.z > 0 Then
      distanceToNearestSphere=distanceToFloor
   End If
   For i= 0 To Ubound(spheresData)
      distanceToSphereCenter = subtract(spheresData(i).position,rayStart)
      b = dotProduct(distanceToSphereCenter,rayDirection) 
      if b < 0 Then continue for
      c = dotProduct(distanceToSphereCenter,distanceToSphereCenter) - b*b
      d = spheresData(i).radius*spheresData(i).radius
      if c > d Then continue for
      distanceToSphere = b - sqr(d - c)
      if distanceToSphere<0 orelse distanceToSphere > distanceToNearestSphere then continue for
      sphereIndex = i : distanceToNearestSphere = distanceToSphere
   Next
   if sphereIndex>-1 then
     intersection = INTERSECTION_SPHERE
     sphereColor = spheresData(sphereIndex).color
     rayEnd = sum(rayStart, scale(rayDirection, distanceToNearestSphere))
     lightDirection = normalize(subtract(lightPosition, rayEnd))
     normal = normalize(subtract(rayEnd, spheresData(sphereIndex).position))
   elseif distanceToFloor > 0 And rayStart.z > 0 then
     intersection = INTERSECTION_FLOOR
     rayEnd = sum(rayStart, scale(rayDirection, distanceToFloor))
     lightDirection = normalize(subtract(lightPosition, rayEnd))
     normal = Vector(0, 0, 1)
   EndIf
   Return Type<tIntersect>(intersection, rayEnd, lightDirection, normal, sphereColor)
End Function

Function getFloorColor(x As Integer, y As Integer) As Vector3D
   If x + y <> 0 Then
      If fmod(x, 3) = 1 And fmod(y, 3) = 1 Then Return CENTER_TILE_COLOR
      Return getFloorColor((x \ 3), (y \ 3))
   End If
   Return OTHERS_TILE_COLOR
End Function

Function sample(rayStart As Vector3D, rayDirection As Vector3D, renderStars As Boolean = False) As Vector3D
  Dim As Vector3D reflectionRayDirection=any
  Dim As Vector3D colour=any
  Dim As Vector3D diffuse=any
  Dim As Vector3D specular=any
  Dim As Vector3D reflection=any
  Dim As Vector3D floorColor=any
  Dim As Vector3D uVector=any
  Dim As Vector3D vVector=any
  Dim As Vector3D randomizedDirection=any
  Dim As tIntersect ti = trace(rayStart, rayDirection)
   
  Select Case as const ti.intersection
  Case INTERSECTION_NONE
    Return Iif(renderStars And Rnd() > 0.5, COLOR_STARS, scale(COLOR_SKY, Pow(1 - rayDirection.z, 4)))
  Case INTERSECTION_SPHERE
    diffuse = scale(ti.sphereColor, 0.7 * dotProduct(ti.normal, ti.lightDirection))
    specular = scale(COLOR_LIGHT_SOURCE, Pow(dotProduct(ti.normal, normalize(subtract(ti.lightDirection, rayDirection))), 64))
    reflectionRayDirection = sum(rayDirection, scale(ti.normal, -2 * dotProduct(ti.normal, rayDirection)))
    reflection = scale(sample(ti.rayEnd, reflectionRayDirection), 0.4)
    colour = sum(diffuse, sum(specular, reflection))
  Case INTERSECTION_FLOOR
    reflectionRayDirection = sum(rayDirection, scale(ti.normal, -2 * dotProduct(ti.normal, rayDirection)))
    floorColor = getFloorColor(CInt(fmod((ti.rayEnd.x + 81) * 27, 81)), CInt(fmod((ti.rayEnd.y + 81) * 27, 81)))
    uVector = crossProduct(rayDirection, reflectionRayDirection)
    vVector = crossProduct(uVector, reflectionRayDirection)
    randomizedDirection = sum(reflectionRayDirection, sum(scale(uVector, (Rnd() - 0.5) / 3), scale(vVector, (Rnd() - 0.5) / 3)))
    colour = scale(sum(floorColor, sample(ti.rayEnd, randomizedDirection)),.5)
  End Select
  if trace(ti.rayEnd, ti.lightDirection).intersection then colour = scale(colour,.5)
  Return colour
End Function



const as integer iW = 512
const as integer iH = 512
const RAYS_PER_PIXEL = 32
const DISTANCE_TO_VIEWPORT = 10
const VIEWPORT_WIDTH = 12
const VIEWPORT_HEIGHT = 12
const ALPHA_CHANNEL_COLOR = 255
const as real scaleX = VIEWPORT_WIDTH / iW
const as real ScaleY = VIEWPORT_HEIGHT / iH


Dim As Vector3D rayStart=any
Dim As Vector3D rayDir=any
Dim As Vector3D viewportPixel=any
Dim As Vector3D UP_DIRECTION = Vector(0, 0, 1)
Dim As Vector3D camera = Vector(-7, -10, 8)
Dim As Vector3D target = Vector(0, 0, 4)
Dim As Vector3D normalToViewport = normalize(subtract(camera, target))
Dim As Vector3D uVector = normalize(crossProduct(UP_DIRECTION, normalToViewport))
Dim As Vector3D vVector = crossProduct(uVector, normalToViewport)
Dim As Vector3D viewportCenter = sum(camera, scale(normalToViewport, -DISTANCE_TO_VIEWPORT))
Dim As Vector3D leftDown = sum(viewportCenter, sum(scale(uVector, -VIEWPORT_WIDTH / 2), scale(vVector, -VIEWPORT_HEIGHT / 2)))

Screenres iW, iH, 32,2
ScreenSet 1,0

#macro colorClamp(_c,_v) 
  if _v>255 then
   _c=255
  elseif _v<0 then
   _c=0
  else
   _c=_v
  endif  
#endmacro  
const as integer ROWHEIGHT = 1
dim as any ptr img = ImageCreate(iW,ROWHEIGHT)
dim as ulong ptr pixels,row
dim as long pitch
ImageInfo img,,,,pitch,pixels : pitch shr=2
dim as ulong r,g,b
dim as Vector3d preScaleX(iW)
for x as integer=0 to iW-1
  preScaleX(x)=scale(uVector, x * ScaleX)
next
dim as real preX(RAYS_PER_PIXEL-1)
dim as real preY(RAYS_PER_PIXEL-1)
for i as integer=0 to RAYS_PER_PIXEL-1
  preX(i)=(Rnd() - 0.5) / 3
  preY(i)=(Rnd() - 0.5) / 3
next  

Dim As Double t = Timer()
for rowStart as integer = 0 to iH-1 step ROWHEIGHT
  row = pixels
  for y as integer = rowStart to rowStart+ROWHEIGHT-1 
    Dim As Vector3D preScaleY = scale(vVector, y * ScaleY)
    For x as integer = 0 to iW-1
      Dim As Vector3D colorSum = Vector(0, 0, 0)
      For j as integer = 0 To RAYS_PER_PIXEL - 1
        rayStart = sum(camera, sum(scale(uVector, preX(j)), scale(vVector, preY(j))))
        viewportPixel = subtract(sum(leftDown, sum(preScaleX(x), preScaleY)),rayStart)
        rayDir = normalize(viewportPixel)
        colorSum = sum(colorSum, sample(rayStart, rayDir, True))
      Next
      colorClamp(r,colorSum.x)
      colorClamp(g,colorSum.y)
      colorClamp(b,colorSum.z)
      row[x]=Rgb(r,g,b)
    next
    row+=pitch
  Next
  put (0,rowStart),img,PSET
  flip 'screenunlock
next
Windowtitle("Ray Tracer / Rendered in " & Timer - t & " seconds")
sleep
D.J.Peters
Posts: 8575
Joined: May 28, 2005 3:28
Contact:

Re: Ray Tracer

Post by D.J.Peters »

I replaced the vector math with macros and the result are ~10 seconds :-)

Joshy

Code: Select all

'Ported from https://js1k.com/2017-magic/demo/2648 by Igor Sbitnev To FB by UEZ build 2021-01-19

' original on old laptop ~24 seconds

' optimized ~11 seconds now :-)
#Include "crt/math.bi"
#Include "fbgfx.bi"
'Using FB
'Randomize

#ifndef __FB_64BIT__
 type real as single
#else 
 type real as double
#endif

Type Vector3D
  As real x, y, z
End Type

Type tSpheresData
   As Vector3D position, color
   As real radius
End Type

enum eIntersection 
  INTERSECTION_NONE
  INTERSECTION_SPHERE
  INTERSECTION_FLOOR
end enum  

Type tIntersect
   As eIntersection intersection
   As Vector3D rayEnd, lightDir, normal, sphereColor
End Type

#define vector(_x,_y,_z) Type<vector3d>(_x, _y, _z)
#define vAdd(_a,_b) vector(_a.x + _b.x, _a.y + _b.y, _a.z + _b.z)
#define vSub(_a,_b) vector(_a.x - _b.x, _a.y - _b.y, _a.z - _b.z)
#define vScale(_a,_b) vector(_a.x*_b, _a.y*_b, _a.z*_b)
#define vDot(_a,_b) (_a.x*_b.x + _a.y*_b.y + _a.z*_b.z)
#define vCross(_a,_b) vector(_a.y*_b.z - _a.z*_b.y, _a.z*_b.x - _a.x*_b.z, _a.x*_b.y - _a.y*_b.x)

Function vNormal(byref v As const Vector3D) As Vector3D
  dim as real l = v.x*v.x + v.y*v.y + v.z*v.z
  if l then l=1/sqr(l)
  return type(v.x*l,v.y*l,v.z*l)
End Function

Dim Shared As Vector3D CENTER_TILE_COLOR, OTHERS_TILE_COLOR, COLOR_SKY, COLOR_LIGHT_SOURCE, COLOR_STARS
CENTER_TILE_COLOR    = Vector(8, 0, 8)
OTHERS_TILE_COLOR    = Vector(8, 5, 8)
COLOR_SKY            = Vector(5, 6, 8)
COLOR_LIGHT_SOURCE   = Vector(8, 8, 8)
COLOR_STARS          = Vector(4, 4, 8)

Dim Shared As tSpheresData spheresData(5)
spheresData(0).position = Vector(10, 2, 2)
spheresData(0).color    = Vector(4, 0, 4)
spheresData(0).radius   = 1.5
spheresData(1).position = Vector(-3, 0, 2)
spheresData(1).color    = Vector(8, 5, 7)
spheresData(1).radius   = 1.5
spheresData(2).position = Vector(3, 0, 2)
spheresData(2).color    = Vector(0, 0, 4)
spheresData(2).radius   = 1.5
spheresData(3).position = Vector(1.5, 0, 4.5)
spheresData(3).color    = Vector(8, 8, 6)
spheresData(3).radius   = 1.5
spheresData(4).position = Vector(-1, 10, 4)
spheresData(4).color    = Vector(0, 4, 4)
spheresData(4).radius   = 4
spheresData(5).position = Vector(0, 0, 7)
spheresData(5).color    = Vector(8, 5, 4)
spheresData(5).radius   = 1.5




const RAYS_PER_PIXEL = 32
dim shared as real preX(RAYS_PER_PIXEL-1)
dim shared as real preY(RAYS_PER_PIXEL-1)

Function trace(byref rayStart As const Vector3D, _
               byref rayDir   As const Vector3D) As tIntersect
   Dim As Vector3D rayEnd=any
   Dim As Vector3D lightDir=any
   Dim As Vector3D normal=any
   Dim As Vector3D sphereColor=any
   Dim As Vector3D raySphere=any
   Dim As Vector3D tmp3=any
   Dim As Vector3D lightPos = Vector(Rnd() * 27, -81 + Rnd() * 27, 81)
   dim as real b=any, c=any, d=any, tSphere=any
   Dim As real tFloor = -rayStart.z / rayDir.z
   Dim As real tNear = 2^31
   dim as eIntersection intersection = INTERSECTION_NONE
   dim as integer sphereIndex=-1
   If tFloor > 0 And rayStart.z > 0 Then
      tNear=tFloor
   End If
   For i as integer = 0 To Ubound(spheresData)
      raySphere = vSub(spheresData(i).position,rayStart)
      b = raySphere.x*rayDir.x _
        + raySphere.y*rayDir.y _
        + raySphere.z*rayDir.z
      if b < 0 Then continue for
      c = raySphere.x*raySphere.x _
        + raySphere.y*raySphere.y _
        + raySphere.z*raySphere.z
      c-= b*b  
      d = spheresData(i).radius*spheresData(i).radius
      if c > d Then continue for
      tSphere = b - sqr(d - c)
      if tSphere<0 orelse tSphere > tNear then continue for
      sphereIndex = i : tNear = tSphere
   Next
   if sphereIndex>-1 then
     intersection = INTERSECTION_SPHERE
     sphereColor = spheresData(sphereIndex).color
     rayEnd = vAdd(rayStart,vScale(rayDir,tNear))
     lightDir = vNormal(vSub(lightPos,rayEnd))
     normal = vNormal(vSub(rayEnd,spheresData(sphereIndex).position))
   elseif tFloor > 0 And rayStart.z > 0 then
     intersection = INTERSECTION_FLOOR
     rayEnd = vAdd(rayStart,vScale(rayDir,tFloor))
     lightDir = vNormal(vSub(lightPos, rayEnd))
     normal = Vector(0, 0, 1)
   EndIf
   Return Type<tIntersect>(intersection, rayEnd, lightDir, normal, sphereColor)
End Function

Function getFloorColor(x As Integer, y As Integer) As Vector3D
   If x + y <> 0 Then
      If fmod(x, 3) = 1 And fmod(y, 3) = 1 Then Return CENTER_TILE_COLOR
      Return getFloorColor((x \ 3), (y \ 3))
   End If
   Return OTHERS_TILE_COLOR
End Function

Function sample(rayStart As Vector3D, rayDir As Vector3D, renderStars As Boolean = False) As Vector3D
  static as integer j=0
  Dim As Vector3D refDir=any
  Dim As Vector3D colour=any
  Dim As Vector3D diffuse=any
  Dim As Vector3D specular=any
  Dim As Vector3D reflection=any
  Dim As Vector3D floorColor=any
  Dim As Vector3D uVector=any
  Dim As Vector3D vVector=any
  Dim As Vector3D rndDir=any
  Dim As Vector3D tmp3=any
  dim as real tmp = any,tmp2 
  Dim As tIntersect ti = trace(rayStart, rayDir)
  Select Case as const ti.intersection
  Case INTERSECTION_NONE
    tmp=Pow(1 - rayDir.z, 4)
    Return Iif(renderStars And Rnd() > 0.5, COLOR_STARS, vScale(COLOR_SKY,tmp))
  Case INTERSECTION_SPHERE
    tmp = vDot(ti.normal, ti.lightDir)*0.7
    diffuse = vScale(ti.sphereColor,tmp)
    tmp=Pow(vDot(ti.normal, vNormal(vSub(ti.lightDir, rayDir))), 64)
    specular = vScale(COLOR_LIGHT_SOURCE,tmp)
    tmp = -2 * vDot(ti.normal, rayDir)
    refDir = vAdd(rayDir,vScale(ti.normal,tmp))
    tmp3=sample(ti.rayEnd, refDir)
    reflection = vScale(tmp3,0.4)
    colour = vAdd(diffuse,vAdd(specular,reflection))
  Case INTERSECTION_FLOOR
    tmp = -2 * vDot(ti.normal, rayDir)
    refDir = vAdd(rayDir,vScale(ti.normal,tmp))
    floorColor = getFloorColor(CInt(fmod((ti.rayEnd.x + 81) * 27, 81)), CInt(fmod((ti.rayEnd.y + 81) * 27, 81)))
    uVector = vCross(rayDir,refDir)
    vVector = vCross(uVector,refDir)
    rndDir = vAdd(refDir,vAdd(vScale(uVector,preX(j)),vScale(vVector,preY(j))))
    tmp3 = sample(ti.rayEnd,rndDir)
    colour = vScale(vAdd(floorColor,tmp3),.5)
    j+=1 : if j=RAYS_PER_PIXEL then j=0
  End Select
  if trace(ti.rayEnd, ti.lightDir).intersection then colour = vScale(colour,.5)
  Return colour
End Function



const as integer iW = 512
const as integer iH = 512
const DISTANCE_TO_VIEWPORT = 10
const VIEWPORT_WIDTH = 12
const VIEWPORT_HEIGHT = 12
const ALPHA_CHANNEL_COLOR = 255
const as real scaleX = VIEWPORT_WIDTH / iW
const as real ScaleY = VIEWPORT_HEIGHT / iH


Dim As Vector3D rayStart=any
Dim As Vector3D rayDir=any
Dim As Vector3D viewportPixel=any
Dim As Vector3D UP_DIRECTION = Vector(0, 0, 1)
Dim As Vector3D camera = Vector(-7, -10, 8)
Dim As Vector3D target = Vector(0, 0, 4)
Dim As Vector3D normalToViewport = vNormal(vSub(camera, target))
Dim As Vector3D uVector = vNormal(vCross(UP_DIRECTION, normalToViewport))
Dim As Vector3D vVector = vCross(uVector, normalToViewport)
Dim As Vector3D viewportCenter = vAdd(camera,vScale(normalToViewport,-DISTANCE_TO_VIEWPORT))
Dim As Vector3D leftDown = vAdd(viewportCenter, vAdd(vScale(uVector,-VIEWPORT_WIDTH / 2), vScale(vVector, -VIEWPORT_HEIGHT / 2)))

Screenres iW, iH, 32,2
ScreenSet 1,0

#macro colorClamp(_c,_v) 
  if _v>255 then
   _c=255
  elseif _v<0 then
   _c=0
  else
   _c=_v
  endif  
#endmacro  

dim as any ptr img = ImageCreate(iW,1)
dim as ulong ptr pixels,row
dim as long pitch
ImageInfo img,,,,pitch,pixels 
pitch shr=2 ' <-- from bytes to ulong
dim as ulong r,g,b

dim as Vector3d preScaleX(iW)
for x as integer=0 to iW-1
  dim as real tmp=x*ScaleX
  preScaleX(x)=vScale(uVector,tmp)
next
for i as integer=0 to RAYS_PER_PIXEL-1
  preX(i)=(Rnd() - 0.5) / 3
  preY(i)=(Rnd() - 0.5) / 3
next
dim as real tmp,onePercent = 100/iH
dim as integer oldPercent,newPercent
dim as Vector3d tmp3
Dim As Double tAll = Timer()
for y as integer = 0 to iH-1
  row = pixels : tmp=y*ScaleY
  Dim As Vector3D preScaleY = vScale(vVector, tmp)
  For x as integer = 0 to iW-1
    Dim As Vector3D colorSum = Vector(0, 0, 0)
    For j as integer = 0 To RAYS_PER_PIXEL - 1
      rayStart = vAdd(camera,vAdd(vScale(uVector,preX(j)),vScale(vVector,preY(j))))
      viewportPixel = vSub(vAdd(leftDown,vAdd(preScaleX(x),preScaleY)),rayStart)
      rayDir = vNormal(viewportPixel)
      tmp3=sample(rayStart, rayDir, True)
      colorSum.x+= tmp3.x
      colorSum.y+= tmp3.y
      colorSum.z+= tmp3.z
    Next
    colorClamp(r,colorSum.x)
    colorClamp(g,colorSum.y)
    colorClamp(b,colorSum.z)
    row[x]=Rgb(r,g,b)
  next
  row+=pitch
  put (0,y),img,PSET
  flip 'screenunlock
  newPercent = y*onePercent
  if newPercent<>oldPercent then
    windowtitle "done: " & newPercent & " %"
    oldPercent=newPercent
  endif  
  if inkey()<>"" then exit for
next
tAll = timer()-tAll
Windowtitle("Ray Tracer / Rendered in " & int(tAll) & " seconds done ...")
sleep
UEZ
Posts: 848
Joined: May 05, 2017 19:59
Location: Germany

Re: Ray Tracer

Post by UEZ »

Well done Joshy. Thanks for sharing it.

Now the speed has been increased to render the scene.
Last edited by UEZ on Sep 23, 2022 9:00, edited 1 time in total.
D.J.Peters
Posts: 8575
Joined: May 28, 2005 3:28
Contact:

Re: Ray Tracer

Post by D.J.Peters »

I'm done with this stuff ;-)

from ~28 seconds to ~5 seconds on 64-bit and ~8 32-bit

I removed vector math vAdd(),vSub(),vScale(),vDot()
vNormal() and vCross() only used to init vectors not while rendering ...

Joshy

Code: Select all

#ifndef __FB_64BIT__
 #cmdline "-gen gcc -arch pentium4-sse3 -Wc -O3 -fpu sse -O 3 -fpmode fast -asm intel"
 type real as single
#else
 #cmdline "-arch x86-64 -Wc -O3 -fpmode fast -fpu sse -O 3 -asm intel"
 type real as double
#endif

' Ported from https://js1k.com/2017-magic/demo/2648 by Igor Sbitnev To FB by UEZ build 2021-01-19

' original on old laptop ~24 seconds optimized by d.j.peters ~5 seconds now :-)

#Include "crt.bi"

Type Vector3D
  As real x, y, z
End Type

Type tSpheresData
   As Vector3D position, colour
   As real radius,r2
End Type

enum eIntersection 
  INTERSECTION_NONE
  INTERSECTION_SPHERE
  INTERSECTION_FLOOR
end enum  

Type tIntersect
   As eIntersection intersection
   As Vector3D rayEnd, lightDir, normal, sphereColor
End Type

#define vector(_x,_y,_z) Type<vector3d>(_x, _y, _z)
#define vCross(_a,_b) vector(_a.y*_b.z - _a.z*_b.y, _a.z*_b.x - _a.x*_b.z, _a.x*_b.y - _a.y*_b.x)
Function vNormal(byref v As const Vector3D) As Vector3D
  dim as real l = v.x*v.x + v.y*v.y + v.z*v.z
  if l then l=1/sqr(l)
  return vector(v.x*l,v.y*l,v.z*l)
End Function

Dim Shared As Vector3D CENTER_TILE_COLOR
Dim Shared As Vector3D OTHERS_TILE_COLOR
Dim Shared As Vector3D COLOR_SKY
Dim Shared As Vector3D COLOR_LIGHT_SOURCE
Dim Shared As Vector3D COLOR_STARS
CENTER_TILE_COLOR  = Vector(8, 0, 8)
OTHERS_TILE_COLOR  = Vector(8, 5, 8)
COLOR_SKY          = Vector(5, 6, 8)
COLOR_LIGHT_SOURCE = Vector(8, 8, 8)
COLOR_STARS        = Vector(4, 4, 8)

Dim Shared As tSpheresData spheresData(5)
                                 ' position ,color,radius, radius squared
spheresData(0)=type<tSpheresData>(Vector(10.0,  2.0, 2.0),Vector(4, 0, 4),1.5,1.5*1.5)
spheresData(1)=type<tSpheresData>(Vector(-3.0,  0.0, 2.0),Vector(8, 5, 7),1.5,1.5*1.5)
spheresData(2)=type<tSpheresData>(Vector( 3.0,  0.0, 2.0),Vector(0, 0, 4),1.5,1.5*1.5)
spheresData(3)=type<tSpheresData>(Vector( 1.5,  0.0, 4.5),Vector(8, 8, 6),1.5,1.5*1.5)
spheresData(4)=type<tSpheresData>(Vector(-1.0, 10.0, 4.0),Vector(0, 4, 4),4.0,4.0*4.0)
spheresData(5)=type<tSpheresData>(Vector( 0.0,  0.0, 7.0),Vector(8, 5, 4),1.5,1.5*1.5)




const RAYS_PER_PIXEL = 32
dim shared as real preX(RAYS_PER_PIXEL-1)
dim shared as real preY(RAYS_PER_PIXEL-1)

Function trace(byref rayStart As const Vector3D, _
               byref rayDir   As const Vector3D) As tIntersect
   Dim As Vector3D rayEnd=any
   Dim As Vector3D lightDir=any
   Dim As Vector3D normal=any
   Dim As Vector3D sphereColor=any
   Dim As Vector3D raySphere=any
   Dim As Vector3D tmp3=any
   Dim As Vector3D lightPos = Vector(Rnd() * 27, -81 + Rnd() * 27, 81)
   dim as real b=any, c=any, d=any, tSphere=any,tmp=any
   Dim As real tFloor = -rayStart.z / rayDir.z
   Dim As real tNear = 2^31
   dim as eIntersection intersection = INTERSECTION_NONE
   dim as integer sphereIndex=-1
   If tFloor > 0 And rayStart.z > 0 Then
      tNear=tFloor
   End If
   For i as integer = 0 To Ubound(spheresData)
      'raySphere = vSub(spheresData(i).position,rayStart)
      with spheresData(i).position  
        raySphere.x = .x-rayStart.x
        raySphere.y = .y-rayStart.y
        raySphere.z = .z-rayStart.z
      end with  
      b = raySphere.x*rayDir.x _
        + raySphere.y*rayDir.y _
        + raySphere.z*rayDir.z
      if b < 0 Then continue for
      c = raySphere.x*raySphere.x _
        + raySphere.y*raySphere.y _
        + raySphere.z*raySphere.z
      c-= b*b  
      d = spheresData(i).r2 
      if c > d Then continue for
      tSphere = b - sqr(d - c)
      if tSphere<0 orelse tSphere > tNear then continue for
      sphereIndex = i : tNear = tSphere
    
   Next
   if sphereIndex>-1 then
     intersection = INTERSECTION_SPHERE
     'sphereColor = spheresData(sphereIndex).colour
     memcpy(@sphereColor.x,@spheresData(sphereIndex).colour.x,sizeof(real)*3)
     rayEnd.x = rayStart.x + rayDir.x*tNear
     rayEnd.y = rayStart.y + rayDir.y*tNear
     rayEnd.z = rayStart.z + rayDir.z*tNear
     'lightDir = vNormal(vSub(lightPos,rayEnd))
     lightDir.x = lightPos.x - rayEnd.x
     lightDir.y = lightPos.y - rayEnd.y
     lightDir.z = lightPos.z - rayEnd.z
     tmp = lightDir.x*lightDir.x
     tmp+= lightDir.y*lightDir.y
     tmp+= lightDir.z*lightDir.z
     if tmp then
       tmp=1/sqr(tmp)
       lightDir.x*=tmp
       lightDir.y*=tmp
       lightDir.z*=tmp
     endif  
     'normal = vNormal(vSub(rayEnd,spheresData(sphereIndex).position))
     normal.x = rayEnd.x - spheresData(sphereIndex).position.x
     normal.y = rayEnd.y - spheresData(sphereIndex).position.y
     normal.z = rayEnd.z - spheresData(sphereIndex).position.z
     tmp = normal.x*normal.x
     tmp+= normal.y*normal.y
     tmp+= normal.z*normal.z
     if tmp then
       tmp=1/sqr(tmp)
       normal.x*=tmp
       normal.y*=tmp
       normal.z*=tmp
     endif  
     
   elseif tFloor > 0 And rayStart.z > 0 then
     intersection = INTERSECTION_FLOOR
     'rayEnd = vAdd(rayStart,vScale(rayDir,tFloor))
     rayEnd.x = rayStart.x + rayDir.x*tFloor
     rayEnd.y = rayStart.y + rayDir.y*tFloor
     rayEnd.z = rayStart.z + rayDir.z*tFloor
     'lightDir = vNormal(vSub(lightPos, rayEnd))
     lightDir.x = lightPos.x - rayEnd.x
     lightDir.y = lightPos.y - rayEnd.y
     lightDir.z = lightPos.z - rayEnd.z
     tmp = lightDir.x*lightDir.x
     tmp+= lightDir.y*lightDir.y
     tmp+= lightDir.z*lightDir.z
     if tmp then
       tmp=1/sqr(tmp)
       lightDir.x*=tmp
       lightDir.y*=tmp
       lightDir.z*=tmp
     endif  
     normal = Vector(0, 0, 1)
   EndIf
   Return Type<tIntersect>(intersection, rayEnd, lightDir, normal, sphereColor)
End Function

Function getFloorColor(x As Integer, y As Integer) As Vector3D
   If x + y <> 0 Then
      If fmod(x, 3) = 1 And fmod(y, 3) = 1 Then Return CENTER_TILE_COLOR
      Return getFloorColor((x \ 3), (y \ 3))
   End If
   Return OTHERS_TILE_COLOR
End Function

Function sample(rayStart As Vector3D, rayDir As Vector3D, renderStars As Boolean = False) As Vector3D
  static as integer j=0
  Dim As Vector3D refDir=any
  Dim As Vector3D colour=any
  Dim As Vector3D diffuse=any
  Dim As Vector3D specular=any
  Dim As Vector3D reflection=any
  Dim As Vector3D floorColor=any
  Dim As Vector3D uVector=any
  Dim As Vector3D vVector=any
  Dim As Vector3D rndDir=any
  Dim As Vector3D tmp3=any
  dim as real tmp = any,tmp2 
  Dim As tIntersect ti = trace(rayStart, rayDir)
  Select Case as const ti.intersection
  Case INTERSECTION_NONE
    if renderStars andalso Rnd() > 0.5 then return COLOR_STARS
    tmp = Pow(1 - rayDir.z, 4)
    tmp3.x = COLOR_SKY.x*tmp
    tmp3.y = COLOR_SKY.y*tmp
    tmp3.z = COLOR_SKY.z*tmp
    Return tmp3'Iif(renderStars And Rnd() > 0.5, COLOR_STARS, vScale(COLOR_SKY,tmp))
  Case INTERSECTION_SPHERE
    'tmp = vDot(ti.normal, ti.lightDir)*0.7
    tmp = ti.normal.x*ti.lightDir.x
    tmp+= ti.normal.y*ti.lightDir.y
    tmp+= ti.normal.z*ti.lightDir.z
    tmp*=0.7
    'diffuse = vScale(ti.sphereColor,tmp)
    colour.x = ti.sphereColor.x*tmp
    colour.y = ti.sphereColor.y*tmp
    colour.z = ti.sphereColor.z*tmp
    'tmp=Pow(vDot(ti.normal, vNormal(vSub(ti.lightDir, rayDir))), 64)
    tmp3.x = ti.lightDir.x - rayDir.x
    tmp3.y = ti.lightDir.y - rayDir.y
    tmp3.z = ti.lightDir.z - rayDir.z
    tmp = tmp3.x*tmp3.x
    tmp+= tmp3.y*tmp3.y
    tmp+= tmp3.z*tmp3.z
    if tmp then
      tmp=1/sqr(tmp)
      tmp3.x*=tmp
      tmp3.y*=tmp
      tmp3.z*=tmp
    endif
    tmp = ti.normal.x*tmp3.x
    tmp+= ti.normal.y*tmp3.y
    tmp+= ti.normal.z*tmp3.z
    tmp = pow(tmp,64)
    ' specular = vScale(COLOR_LIGHT_SOURCE,tmp)
    colour.x += COLOR_LIGHT_SOURCE.x*tmp
    colour.y += COLOR_LIGHT_SOURCE.y*tmp
    colour.z += COLOR_LIGHT_SOURCE.z*tmp
    ' tmp = -2 * vDot(ti.normal, rayDir)
    tmp = ti.normal.x*rayDir.x
    tmp+= ti.normal.y*rayDir.y
    tmp+= ti.normal.z*rayDir.z
    tmp*=-2
    ' refDir = vAdd(rayDir,vScale(ti.normal,tmp))
    refDir.x = rayDir.x + ti.normal.x*tmp
    refDir.y = rayDir.y + ti.normal.y*tmp
    refDir.z = rayDir.z + ti.normal.z*tmp
    tmp3=sample(ti.rayEnd, refDir)
    'reflection = vScale(tmp3,0.4)
    reflection.x = tmp3.x*0.4
    reflection.y = tmp3.y*0.4
    reflection.z = tmp3.z*0.4
    'colour = vAdd(diffuse,vAdd(specular,reflection))
    colour.x +=  reflection.x
    colour.y +=  reflection.y
    colour.z +=  reflection.z
  Case INTERSECTION_FLOOR
    'tmp = -2 * vDot(ti.normal, rayDir)
    tmp = ti.normal.x*rayDir.x
    tmp+= ti.normal.y*rayDir.y
    tmp+= ti.normal.z*rayDir.z
    tmp*=-2
    'refDir = vAdd(rayDir,vScale(ti.normal,tmp))
    refDir.x = rayDir.x + ti.normal.x*tmp
    refDir.y = rayDir.y + ti.normal.y*tmp
    refDir.z = rayDir.z + ti.normal.z*tmp
    floorColor = getFloorColor(CInt(fmod((ti.rayEnd.x + 81) * 27, 81)), CInt(fmod((ti.rayEnd.y + 81) * 27, 81)))
    ' uVector = vCross(rayDir,refDir)
    uVector.x = rayDir.y*refDir.z - rayDir.z*refDir.y
    uVector.y = rayDir.z*refDir.x - rayDir.x*refDir.z
    uVector.z = rayDir.x*refDir.y - rayDir.y*refDir.x
    ' vVector = vCross(uVector,refDir)
    vVector.x = uVector.y*refDir.z - uVector.z*refDir.y
    vVector.y = uVector.z*refDir.x - uVector.x*refDir.z
    vVector.z = uVector.x*refDir.y - uVector.y*refDir.x
    'rndDir = vAdd(refDir,vAdd(vScale(uVector,preX(j)),vScale(vVector,preY(j))))    
    tmp = preX(j) : tmp2 = preY(j)
    rndDir.x = refDir.x + uVector.x*tmp + vVector.x*tmp2
    rndDir.y = refDir.y + uVector.y*tmp + vVector.y*tmp2
    rndDir.z = refDir.z + uVector.z*tmp + vVector.z*tmp2
    tmp3 = sample(ti.rayEnd,rndDir)
    'colour = vScale(vAdd(floorColor,tmp3),.5)
    colour.x = floorColor.x + tmp3.x : colour.x*=.5
    colour.y = floorColor.y + tmp3.y : colour.y*=.5
    colour.z = floorColor.z + tmp3.z : colour.z*=.5
    j+=1 : if j=RAYS_PER_PIXEL then j=0
  End Select
  if trace(ti.rayEnd, ti.lightDir).intersection then 
    'colour = vScale(colour,.5)
    colour.x *= .5
    colour.y *= .5
    colour.z *= .5
  endif  
  Return colour
End Function



const as integer iW = 512
const as integer iH = 512
const DISTANCE_TO_VIEWPORT = 10
const VIEWPORT_WIDTH = 12
const VIEWPORT_HEIGHT = 12
const ALPHA_CHANNEL_COLOR = 255
const as real scaleX = VIEWPORT_WIDTH / iW
const as real ScaleY = VIEWPORT_HEIGHT / iH


Dim As Vector3D rayStart=any
Dim As Vector3D rayDir=any
Dim As Vector3D viewportPixel=any
Dim As Vector3D viewportCenter = any
Dim As Vector3D leftDown = any
Dim As Vector3D UP_DIRECTION = Vector(0, 0, 1)
Dim As Vector3D camera = Vector(-7, -10, 8)
Dim As Vector3D target = Vector(0, 0, 4)
Dim As Vector3D normalToViewport = vNormal(vector(camera.x-target.x,camera.y-target.y,camera.z-target.z ))
Dim As Vector3D uVector = vNormal(vCross(UP_DIRECTION, normalToViewport))
Dim As Vector3D vVector = vCross(uVector, normalToViewport)

viewportCenter.x = camera.x + normalToViewport.x*-DISTANCE_TO_VIEWPORT
viewportCenter.y = camera.y + normalToViewport.y*-DISTANCE_TO_VIEWPORT
viewportCenter.z = camera.z + normalToViewport.z*-DISTANCE_TO_VIEWPORT

leftDown.x = viewportCenter.x + uVector.x*-VIEWPORT_WIDTH/2 + vVector.x*-VIEWPORT_HEIGHT/2
leftDown.y = viewportCenter.y + uVector.y*-VIEWPORT_WIDTH/2 + vVector.y*-VIEWPORT_HEIGHT/2
leftDown.z = viewportCenter.z + uVector.z*-VIEWPORT_WIDTH/2 + vVector.z*-VIEWPORT_HEIGHT/2

Screenres iW, iH, 32,2
ScreenSet 1,0

#macro colorClamp(_c,_v) 
  if _v>255 then
   _c=255
  elseif _v<0 then
   _c=0
  else
   _c=_v
  endif  
#endmacro  

dim as any ptr img = ImageCreate(iW,1)
dim as ulong ptr pixels,row
dim as long pitch
ImageInfo img,,,,pitch,pixels 
pitch shr=2 ' <-- from bytes to ulong
dim as ulong r,g,b

dim as Vector3d preScaleX(iW)
for x as integer=0 to iW-1
  dim as real tmp=x*ScaleX
  preScaleX(x).x = uVector.x*tmp
  preScaleX(x).y = uVector.y*tmp
  preScaleX(x).z = uVector.z*tmp
next
for i as integer=0 to RAYS_PER_PIXEL-1
  preX(i)=(Rnd() - 0.5) / 3
  preY(i)=(Rnd() - 0.5) / 3
next
dim as real tmp,tmp2,onePercent = 100/iH
dim as integer oldPercent,newPercent
dim as Vector3d tmp3,preScaleY
Dim As Double tAll = Timer()
for y as integer = 0 to iH-1
  row = pixels 
  tmp=y*ScaleY
  preScaleY.x = vVector.x*tmp
  preScaleY.y = vVector.y*tmp
  preScaleY.z = vVector.z*tmp  
  For x as integer = 0 to iW-1
    Dim As Vector3D colorSum = Vector(0, 0, 0)
    For j as integer = 0 To RAYS_PER_PIXEL - 1
      'rayStart = vAdd(camera,vAdd(vScale(uVector,preX(j)),vScale(vVector,preY(j))))
      tmp = preX(j) : tmp2 = preY(j)
      rayStart.x = camera.x + uVector.x*tmp + vVector.x*tmp2
      rayStart.y = camera.y + uVector.y*tmp + vVector.y*tmp2
      rayStart.z = camera.z + uVector.z*tmp + vVector.z*tmp2
      'viewportPixel = vSub(vAdd(leftDown,vAdd(preScaleX(x),preScaleY)),rayStart)
      tmp3 = preScaleX(x)
      rayDir.x = leftDown.x + tmp3.x + preScaleY.x : rayDir.x-=rayStart.x
      rayDir.y = leftDown.y + tmp3.y + preScaleY.y : rayDir.y-=rayStart.y
      rayDir.z = leftDown.z + tmp3.z + preScaleY.z : rayDir.z-=rayStart.z
      tmp = rayDir.x*rayDir.x
      tmp+= rayDir.y*rayDir.y
      tmp+= rayDir.z*rayDir.z
      if tmp then
        tmp=1/sqr(tmp)
        rayDir.x *= tmp
        rayDir.y *= tmp
        rayDir.z *= tmp
      endif
      'rayDir = vNormal(viewportPixel)
      'rayDir.x = viewportPixel.x
      'rayDir.y = viewportPixel.y
      'rayDir.z = viewportPixel.z
      tmp3=sample(rayStart, rayDir, True)
      colorSum.x+= tmp3.x
      colorSum.y+= tmp3.y
      colorSum.z+= tmp3.z
    Next
    colorClamp(r,colorSum.x)
    colorClamp(g,colorSum.y)
    colorClamp(b,colorSum.z)
    row[x]=Rgb(r,g,b)
  next
  row+=pitch
  put (0,y),img,PSET
  flip 'screenunlock
  newPercent = y*onePercent
  if newPercent<>oldPercent then
    windowtitle "done: " & newPercent & " %"
    oldPercent=newPercent
  endif  
  if ((y mod 8)=0) andalso inkey()<>"" then exit for
next
tAll = timer()-tAll
Windowtitle("Ray Tracer / Rendered in " & int(tAll) & " seconds done ...")
sleep
Post Reply