Rem Project: Ray Marching Version 1
Rem Created: Sunday, September 25, 2011
Rem ***** Main Source File *****
//
Type rtVec
x as float
y as float
z as float
EndType
//
Randomize Timer()
//
Dim RayDir(256*256) as rtVec
Dim RayCol(256*256) as rtVec
//
For i = 0 To 255
For j = 0 To 255
dx# = i - 128.0
dy# = j - 128.0
dz# = 128.0
dm# = 1.0 / Sqrt( dx# * dx# + dy# * dy# + dz# * dz# )
RayDir(i+j*256).x = dx# * dm#
RayDir(i+j*256).y = dy# * dm#
RayDir(i+j*256).z = dz# * dm#
RayCol(i+j*256).x = i * dm#
RayCol(i+j*256).y = j * dm#
RayCol(i+j*256).z = dz# * dm#
Next
Next
//
ox# = 0
oy# = 0
oz# = -1280
Repeat
aa# = WrapValue(aa#+1.0)
cc# = Cos(aa#)
ss# = Sin(aa#)
inc oz# , 1
ox#=ox#+cc#
oy#=oy#+ss#
//
lx# = ox#-100
ly# = oy#-1000
lz# = oz#-1000.0
Cls 0x0
Lock Pixels
For i = 0 To 255 Step 2
For j = 0 To 255 Step 2
dii = i + ( j << 8 )
dx# = RayDir(dii).x
dy# = RayDir(dii).y
dz# = RayDir(dii).z
ty# = dy#
dy# = dy# * cc# - dz# * ss#
dz# = dz# * cc# + ty# * ss#
tx# = dx#
dx# = dx# * cc# - dz# * ss#
dz# = dz# * cc# + tx# * ss#
tx# = dx#
dx# = dx# * cc# - dy# * ss#
dy# = dy# * cc# + tx# * ss#
rx# = ox#
ry# = oy#
rz# = oz#
For k = 0 To 256
fx# = ( rx# + 256 ) Mod 64
fy# = ( ry# + 256 ) Mod 64
fz# = ( rz# + 256 ) Mod 64
di# = Sample( fx# , fy# , fz# )
//
If di# > 1000.0
Flag = 0
Exit
Endif
//
If di# < 0.0001
Flag = 1
Exit
Endif
rx# = rx# + di# * dx#
ry# = ry# + di# * dy#
rz# = rz# + di# * dz#
Next
If Flag = 1
ep# = 0.000009
nx# = (rx# - ep#) - ( rx# + ep# )
ny# = (ry# - ep#) - ( ry# + ep# )
nz# = (rz# - ep#) - ( rz# + ep# )
nm# = 1.0 / Sqrt( nx# * nx# + ny# * ny# + nz# * nz# )
nx# = nx# * nm#
ny# = ny# * nm#
nz# = nz# * nm#
ix# = lx# - rx#
iy# = ly# - ry#
iz# = lz# - rz#
im# = 1.0 / Sqrt( ix# * ix# + iy# * iy# + iz# * iz# )
ix# = ix# * im#
iy# = iy# * im#
iz# = iz# * im#
lc# = ix# * nx# + iy# * ny# + iz# * nz#
If lc# > 0
df# = lc# * 0.9
rc# = ( RayCol(dii).x ) * df#
gc# = ( RayCol(dii).y ) * df#
bc# = ( RayCol(dii).z ) * df#
//
Dotx2(i,j,Rgb(rc#*255,gc#*255,bc#*255),2)
Endif
Flag = 0
Endif
Next
Next
Unlock Pixels
Until EscapeKey()
End
Function Dotx2(x,y,c,s)
If s > 0
DotFast(x,y,c)
s = s >> 1
Dotx2(x ,y ,c,s)
Dotx2(x ,y+1,c,s)
Dotx2(x+1,y+1,c,s)
Dotx2(x+1,y ,c,s)
Endif
EndFunction
//
Function DotFast(x,y,c)
Pixel = Get Pixels Pointer() + ( y * Get Pixels Pitch() + ( x << 2 ) )
*Pixel = c
EndFunction
//
Function Min(a#,b#)
if a# > b# then exitfunction b#
EndFunction a#
//
Function Max(a#,b#)
if a# < b# then exitfunction b#
EndFunction a#
//
Function rmCube(x#,y#,z#,s#)
a# = Max( Abs(x#) - s# , 0.0 )
b# = Max( Abs(y#) - s# , 0.0 )
c# = Max( Abs(z#) - s# , 0.0 )
d# = Max(a#,Max(b#,c#))
EndFunction d#
//
Function rmSphere(x#,y#,z#,r#)
d# = Sqrt( x# * x# + y# * y# + z# * z# ) - r#
EndFunction d#
//
Function Sample(x#,y#,z#)
di# = rmCube(x#,y#,z#,20.0)
EndFunction di#
hexeg0n