With ovoids,highlights and background
include "win64.inc"
Sub Pause()
AscKey=0
While AscKey=0
Events
sleep 50
iF WinExit=1
WinEnd
ExitProcess 0
End iF
Wend
End Sub
sys scr=800
Window "Ray4" ,scr,scr,2
sys_mode=4
ClsColor 32,0,0
FlipBuffer
'light
'=====
single lx,ly,lz
lx=sqr(1/3)
ly=lx
lz=lx
'lx=sqr(.5)
'ly=lx
'lz=0
ambi=31 'light ambient / 255
diff=224 'light diffuse / 255
Function Noise(sys i) as Single
'==============================
Static As Single f, d=1/0x7fffffff
mov eax,i
xor eax,0x35353535
imul eax,eax
ror eax,17
imul eax,i
ror eax,7
push eax
fild dWord [esp]
add esp,4
fmul dWord d
fstp dWord _return
End Function
function color(single li,pr,pg,pb) as sys
'========================================
sys cr,cg,cb
if li>1 then li=1 'clamp
if li<0 then li=0 'clamp
cr=(diff*li+ambi)*pr
cg=(diff*li+ambi)*pg
cb=(diff*li+ambi)*pb
return cb*0x10000+cg*0x100+cr 'composite
end function
function texture(single li,pr,pg,pb,tx,x,y) as sys
'==============================================
sys cr,cg,cb,mz,my
single n,am,di
n=1-tx*3
mx=x>>2
my=y>>2
n+=noise(mx+my*0x7fff)*tx
mx=x>>1
my=y>>1
n+=noise(mx+my*0x7fff)*tx
mx=x
my=y
n+=noise(mx+my*0x7fff)*tx
'
if li>.99 then li=1 'clamp
if li<0 then li=0 'clamp
am=ambi
di=diff*li
if li>=1 then
if li>pr then pr=.5*(li+pr)
if li>pg then pg=.5*(li+pg)
if li>pb then pb=.5*(li+pb)
n=.5*(li+n)
end if
cr=(n*(di+am))*pr
cg=(n*(di+am))*pg
cb=(n*(di+am))*pb
return cb*0x10000+cg*0x100+cr 'composite
end function
function PixelAvg(sys cc,pp) as sys
'==================================
lea esi,pp
mov ecx,[cc]
mov edx,[esi]
'RED
xor eax,eax
mov al,cl
add al,dl
jnc fwd nc
add eax,256
.nc
shr eax,1
mov [esi],al
'GREEN
xor eax,eax
shr ecx,8
shr edx,8
inc esi
mov al,cl
add al,dl
jnc fwd nc
add eax,256
.nc
shr eax,1
mov [esi],al
'BLUE
xor eax,eax
shr ecx,8
shr edx,8
inc esi
mov al,cl
add al,dl
jnc fwd nc
add eax,256
.nc
shr eax,1
mov [esi],al
return pp
end function
function sphere(sys px,py,ra, single yx,pr,pg,pb,tx)
'===============================================
sys x,y,ri,pp,d
single r,nx,ny,nz,h
single li,t
single ry=ra*yx
for y=-ry to ry
for x=-ra to ra
r=hypot(x,y/yx)
ri=r
if r<=ra
nx=x/ra
ny=y/ry
nz=sqr(1-nx*nx-ny*ny) 'assume positive
ny*=yx
h=1/sqr(nx*nx+ny*ny+nz*nz)
nx*=h
ny*=h
nz*=h
li=lx*nx+ly*ny+lz*nz
'cc=color li,pr,pg,pb
cc=Texture li,pr,pg,pb,tx,x,y
pixel px+x,scr-py-y,cc
'
'ANTIALIAS AVERAGING ON SPHERE EDGES
'
if ri=ra
if x>=0 then d=1 else d=-1
pp=Getpixel bHdc,px+x+d,scr-py-y
pp=PixelAvg cc,pp
pixel px+x,scr-py-y,pp
end if
end if
next
next
end function
'objects
'=======
'background
single f,i
for x=0 to <scr
i=6
for y=0 to <scr
pixel x,scr-y,i*(1+sin(f))
i+=.1
next
f+=.05
next
'sphere posX, posY, radius, yxRatio, red/1, green/1, blue/1, texture/1
sphere 220,640,70,.75,.7,.0,.5,.02
sphere 520,600,80,1,.5,.0,.7,.1
sphere 320,420,200,1,1,1,.5,.05
sphere 400,250,150,1,1,.3,.5,.03
sphere 550,250,100,1.9,1,1,1,.07
sphere 650,200,100,1.5,1,1,1,.07
FlipBuffer
pause
Charles
