You can switch between RayTracing and PhotonMapping while rendering
[p] = photon mapping
[r] = ray tracing
[v] = view photons
any other key = quit
Joshy
Code: Select all
' RayTracing versus PhotonMapping
type REAL as single
const as integer Dimension = 256*2
const as integer Types = 2
const as integer MaxPhotons = 3000
const as integer MaxRelections = 3
const as REAL gRadius2 = 0.7
const as REAL gExposure = 40
dim shared as integer Objects(1) = {1,5}
dim shared as REAL gAmbient = 0.2
dim shared as REAL gOrigin(2) = {0 ,0 , 0}
dim shared as REAL gLight(2) = {0,1.2,3}
dim shared as REAL gSphere(3) = { -0.5, -0.75, 4, 0.75}
dim shared as REAL gPlanes(4,1) = {{0, 1.5}, _
{1, -1.5}, _
{0, -1.5}, _
{1, 1.5}, _
{2, 5.0}}
dim shared as boolean gPhotonMapping = true
dim shared as integer NumberOfPhotons(1,4)
dim shared as REAL gPhotons(1,4,MaxPhotons*5,2,2)
dim shared as boolean gIntersect
dim shared as integer gType
dim shared as integer gIndex
dim shared as REAL gDist2, gDist
dim shared as REAL gPoint(2)
dim shared as boolean gEmpty = true
dim shared as boolean gView3D
dim shared as integer pRow, pCol, pIteration, pMax
declare sub GatherPhotons(r() as REAL, p() as REAL,typ as integer, index as integer)
declare sub GetColor(r() as REAL, rgbIn() as REAL, typ as integer, index as integer)
declare sub StorePhoton(typ as integer,index as integer, _
location() as REAL,direction() as REAL,energy() as REAL)
declare sub ShadowPhoton(ray() as REAL)
declare sub DrawPhoton(frgb() as REAL,p() as REAL)
declare sub ResetRender
declare sub Render
#define min(a,b) iif(a<b,a,b)
#define max(a,b) iif(a>b,a,b)
#macro NormalizeVec(r,v)
scope
dim as REAL L2 = v(0)*v(0)+v(1)*v(1)+v(2)*v(2)
if l2<>0 then L2=1.0/sqr(L2)
r(0)=v(0)*L2
r(1)=v(1)*L2
r(2)=v(2)*L2
end scope
#endmacro
#macro SubVec(r,a,b)
r(0)=a(0)-b(0)
r(1)=a(1)-b(1)
r(2)=a(2)-b(2)
#endmacro
#macro AddVec(r,a,b)
r(0)=a(0)+b(0)
r(1)=a(1)+b(1)
r(2)=a(2)+b(2)
#endmacro
#macro MulScalarVec(r,a,b)
r(0)=a(0)*b
r(1)=a(1)*b
r(2)=a(2)*b
#endmacro
#define DotProduct(a,b) (a(0)*b(0) + a(1)*b(1) + a(2)*b(2))
#define rnd2 (rnd-rnd)
#macro RandomVec(r)
r(0)=rnd-rnd
r(1)=rnd-rnd
r(2)=rnd-rnd
#endmacro
#define odd(xx) (xx and 1)
function Distance2(a() as REAL, _
b() as REAL, _
d2 as REAL) as boolean
dim as REAL c = a(0) - b(0)
dim as REAL d = c*c
if (d > d2) then return false
c = a(1) - b(1)
d += c*c
if (d > d2) then return false
c = a(2) - b(2)
d += c*c
if (d > d2) then return false
gDist2 = d2
return true
end function
sub RaySphere(idx as integer,r() as REAL, o() as REAL)
dim as REAL s(2)
SubVec(s,gSphere,o)
dim as REAL radius = gSphere(3)
dim as REAL A = DotProduct(r,r)
dim as REAL B = -2.0 * DotProduct(s,r)
dim as REAL C = DotProduct(s,s) - (radius*radius)
dim as REAL D = B*B - 4*A*C
if (D < 0.0) then return
dim as REAL sign = iif(C < -0.00001,1,-1)
dim as REAL l = (-B + sign*sqr(D))/(2*A)
if (l<0) or (l>gDist) then return
gType = 0
gIndex = idx
gDist = l
gIntersect = true
end sub
sub RayPlane(idx as integer, r() as REAL,o() as REAL)
dim as integer axis = gPlanes(idx,0)
if r(axis)=0 then return
dim as REAL l = (gPlanes(idx,1) - o(axis)) / r(axis)
if (l<0) or (l>gDist) then return
gType = 1
gIndex = idx
gDist = l
gIntersect = true
end sub
sub RayObject(typ as integer, idx as integer, r()as REAL, o() as REAL)
if (typ = 0) then
RaySphere(idx,r(),o())
else
RayPlane(idx,r(),o())
end if
end sub
sub SphereNormal(r() as REAL,P() as REAL)
dim as REAL v(2)
SubVec(v,P,gSphere)
NormalizeVec(r,v)
end sub
sub PlaneNormal(r() as REAL, idx as integer, P() as REAL, O() as REAL)
dim as integer axis = gPlanes(idx,0)
dim as REAL N(2)
N(axis) = O(axis) - gPlanes(idx,1)
NormalizeVec(r,N)
end sub
sub SurfaceNormal(r() as REAL, _
typ as integer, _
idx as integer, _
P() as REAL, _
Inside() as REAL)
if (typ = 0) then
SphereNormal(r(),P())
else
PlaneNormal(r(),idx,P(),Inside())
end if
end sub
sub MirrorVec(Ret() as REAL,_
Ray() as REAL, _
FromPoint() as REAL)
dim as REAL N(2)=any,tmp(2)=any
SurfaceNormal(N(),gType, gIndex, gPoint(), fromPoint())
MulScalarVec(tmp,N,(2 * DotProduct(ray,N) ))
SubVec(tmp,ray,tmp)
NormalizeVec(Ret,tmp)
end sub
'
' Lighting
'
function LightDiffuse(N() as REAL,P() as REAL) as REAL
dim as REAL L(2)=any
SubVec(L,gLight,P)
NormalizeVec(L,L)
return DotProduct(N,L)
end function
function LightObject(typ as integer, _
idx as integer, _
P() as REAL, _
Ambient as REAL ) as REAL
dim as REAL N(2)=any
SurfaceNormal(N(),typ, idx, P(), gLight())
dim as REAL L = LightDiffuse(N() , P() )
return min(1.0, max(L, Ambient))
end function
'
' Raytracing
'
sub Raytrace(ray() as REAL,origin() as REAL)
gIntersect = false
gDist = 999999.9
for typ as integer = 0 to Types-1
for idx as integer = 0 to Objects(typ)-1
RayObject(typ,idx,ray(),origin())
next
next
end sub
sub AbsorbColor(ret() as REAL, _
rgbIn() as REAL, _
r as REAL,g as REAL,b as REAL) ' e.g. White Light Hits Red Wall
dim as REAL rgbOut(2)={r,g,b}
for c as integer =0 to 2
ret(c) = min(rgbOut(c),rgbIn(c))
next
end sub
sub GetColor(r() as REAL, _
rgbIn() as REAL, _
typ as integer, _
idx as integer)
if (typ=0) then ' sphere
AbsorbColor(r(),rgbIn(), 1, 1, 0.5)
elseif (typ=1) then ' plane
if idx=0 then
AbsorbColor(r(),rgbIn(), 1.0, 0, 0)
elseif idx=2 then
AbsorbColor(r(),rgbIn(), 0, 1.0, 0)
else
AbsorbColor(r(),rgbIn(), 1, 1, 1)
end if
end if
end sub
sub ComputePixelColor(prgb() as REAL,x as REAL,y as REAL)
dim as REAL ray(2) = { x/Dimension - 0.5 , _
-(y/Dimension - 0.5), _
1.0}
Raytrace(ray(), gOrigin())
if (gIntersect) then
MulScalarVec(gPoint,ray,gDist)
if (gType = 0) then
MirrorVec(ray(),ray(),gOrigin())
Raytrace(ray(), gPoint())
if (gIntersect) then
dim as REAL tmp(2)=any
MulScalarVec(tmp,ray,gDist)
AddVec(gPoint,tmp,gPoint)
end if
end if
if (gPhotonMapping) then
GatherPhotons(prgb(),gPoint(),gType,gIndex)
else
dim as integer tType = gType
dim as integer tIndex = gIndex
dim as REAL a = gAmbient
dim as REAL tmp(2)=any
SubVec(tmp,gPoint,gLight)
Raytrace(tmp(),gLight())
if (tType = gType) and (tIndex = gIndex) then
a = LightObject(gType, gIndex, gPoint(), gAmbient)
end if
prgb(0)=a:prgb(1)=a:prgb(2)=a
GetColor(prgb(),prgb(),tType,tIndex)
end if
end if
end sub
'
' Photon Mapping
'
sub GatherPhotons(energy() as REAL, _
p() as REAL, _
typ as integer, _
idx as integer)
dim as REAL N(2)=any
dim as REAL tmp(2)=any
dim as REAL g(2)=any
dim as REAL weight=any
dim as REAL frgb(2)=any
SurfaceNormal(N(), typ, idx, p(), gOrigin())
for i as integer = 0 to NumberOfPhotons(typ,idx)-1
' location
g(0)=gPhotons(typ,idx,i,0,0)
g(1)=gPhotons(typ,idx,i,0,1)
g(2)=gPhotons(typ,idx,i,0,2)
if (Distance2(p(),g(),gRadius2)) then
' direction
g(0)=gPhotons(typ,idx,i,1,0)
g(1)=gPhotons(typ,idx,i,1,1)
g(2)=gPhotons(typ,idx,i,1,2)
weight = max(0.0, -DotProduct(N,g) )
weight *= (1.0 - sqr(gDist2)) / gExposure
' energy
g(0)=gPhotons(typ,idx,i,2,0)
g(1)=gPhotons(typ,idx,i,2,1)
g(2)=gPhotons(typ,idx,i,2,2)
MulScalarVec(tmp,g,weight)
AddVec(frgb,frgb,tmp)
end if
next
for j as integer=0 to 2
energy(j)=max(0,min(1,frgb(j) ) )
next
end sub
sub EmitPhotons
randomize 1
dim as REAL frgb(2)=any
dim as REAL ray(2)=any
dim as REAL p(2)=any
for typ as integer = 0 to Types-1
for idx as integer = 0 to Objects(typ)-1
NumberOfPhotons(typ,idx) = 0
next
next
for i as integer = 0 to MaxPhotons-1
dim as integer bounces = 1
' white photon color
frgb(0)=1:frgb(1)=1:frgb(2)=1
RandomVec(ray)
NormalizeVec(ray,ray)
p(0) = gLight(0)
p(1) = gLight(1)
p(2) = gLight(2)
while (p(1) >= gLight(1))
dim as REAL N(2)=any
RandomVec(N)
NormalizeVec(N,N)
MulScalarVec(N,N,0.75)
AddVec(p,gLight,N)
wend
Raytrace(ray(), p())
if abs(p(0) > 1.5) then Continue for
if abs(p(1) > 1.5) then Continue for
if Distance2(p(), gSphere(),gSphere(3)*gSphere(3)) then Continue for
while (gIntersect<>0) and (bounces <= MaxRelections)
dim as REAL tmp(2)=any
MulScalarVec(tmp,ray,gDist)
AddVec(gPoint, tmp, p)
GetColor(frgb(),frgb(),gType,gIndex)
MulScalarVec(frgb,frgb, 1.0/sqr(bounces))
StorePhoton(gType, gIndex, gPoint(), ray(),frgb())
DrawPhoton(frgb(), gPoint())
ShadowPhoton(ray())
MirrorVec(ray(),ray(),p())
Raytrace(ray(), gPoint())
p(0) = gPoint(0)
p(1) = gPoint(1)
p(2) = gPoint(2)
bounces+=1
wend
next
end sub
sub StorePhoton(typ as integer, _
idx as integer, _
l() as REAL,_
d() as REAL, _
e() as REAL)
dim as integer Photon=NumberOfPhotons(typ,idx)
for i as integer=0 to 2
gPhotons(typ,idx,Photon,0,i) = l(i) ' Location
gPhotons(typ,idx,Photon,1,i) = d(i) ' Direction
gPhotons(typ,idx,Photon,2,i) = e(i) ' Energy
next
NumberOfPhotons(typ,idx)=Photon+1
end sub
sub ShadowPhoton(ray() as REAL)
dim as REAL shadow(2) = {-0.25,-0.25,-0.25}
dim as REAL tPoint(2) = {gPoint(0), gPoint(1),gPoint(2)}
dim as integer tType = gType ' Save State
dim as integer tIndex = gIndex
dim as REAL BumpedPoint(2)
MulScalarVec(BumpedPoint,ray,0.000001)
AddVec(BumpedPoint,gPoint,BumpedPoint)
Raytrace(ray(), BumpedPoint())
dim as REAL ShadowPoint(2)=any
MulScalarVec(ShadowPoint,ray,gDist)
AddVec(ShadowPoint,ShadowPoint, BumpedPoint) ' 3D Point
StorePhoton(gType, gIndex, ShadowPoint(), ray(), shadow())
gPoint(0) = tPoint(0)
gPoint(1) = tPoint(1)
gPoint(2) = tPoint(2)
gType = tType
gIndex = tIndex
end sub
sub Render
dim as integer x,y,iterations = 0
dim as integer nruns
nruns=256
while (iterations < nruns)
nruns=max(pMax, 256)
if (pCol >= pMax) then
pRow+=1
pCol = 0
if (pRow >= pMax) then
pIteration+=1
pRow = 0
pMax = int(2^pIteration)
end if
end if
dim as integer pNeedsDrawing = (pIteration = 1) or odd(pRow) _
or ( (odd(pRow)=0) and odd(pCol))
x = pCol * (Dimension/pMax)
y = pRow * (Dimension/pMax)
pCol+=1
if (pNeedsDrawing) then
iterations+=1
dim as REAL b(2)
ComputePixelColor(b(),x,y)
dim as uinteger col=rgb(b(0)*255,b(1)*255,b(2)*255)
line (x,y)-step((Dimension/pMax)-1,(Dimension/pMax)-1),col,BF' Draw the Possibly Enlarged Pixel
'pset (x,y),col
end if
wend
if (pRow = Dimension-1) then
gEmpty = false
end if
end sub
sub ResetRender()
pRow=0
pCol=0
pIteration=1
pMax=2
gEmpty=true
if (gPhotonMapping and not gView3D) then
EmitPhotons()
end if
end sub
sub setup()
screenres Dimension,Dimension,24
ResetRender
end sub
sub drawit()
if gPhotonMapping then
windowtitle "[r]aytracing [v]iew"
else
windowtitle "[p]hoton Mapping [v]iew"
end if
if (gView3D) then
if (gEmpty) then
cls
emitPhotons()
gEmpty = false
end if
else
if (gEmpty) then
render()
end if
end if
end sub
sub DrawPhoton(frgb() as REAL,p() as REAL)
if (gView3D=true) and cbool(p(2) > 0.0) then
dim as integer x = (Dimension/2) + int(Dimension * p(0)/p(2))
dim as integer y = (Dimension/2) + int(Dimension * -p(1)/p(2))
if (y <= Dimension) then
pset (x,y),rgb(frgb(0)*255,frgb(1)*255,frgb(2)*255)
end if
end if
end sub
sub SwitchToMode(i as string)
if (i="r") then
gView3D = false
gPhotonMapping = false
resetRender()
elseif (i="p") then
gView3D = false
gPhotonMapping = true
resetRender()
elseif (i="v") then
gView3D = true
resetRender()
end if
end sub
'
' main
'
dim as string Key
Setup()
while key=""
key=lcase(inkey)
if key="r" or key="p" or key="v" then
SwitchToMode(key)
key=""
end if
DrawIt()
sleep(100)
wend