include "..\GDIWindow\window.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 "Ray5" ,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

int ambi=31  'light ambient / 255
int 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 function
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
  single mx=x '.25
  single my=y '.25
  n+=noise(mx+my*0x7fff)*tx
  mx=x '.5
  my=y '.5
  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,cc
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

sub background1()
'================
single f,i
sys x,y
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
end sub

sub background2()
'================
single fx,fy,i
sys r,g,b,c,x,y
for x=0 to <scr
i=6
fy=0
for y=0 to <scr
r=i*(1+cos(fx))
g=i*(1+cos(fy*2))
b=i*(1+cos(fx*3))
c=r+g*0x100+b*0x10000
pixel x,scr-y,c
i+=.1
fy+=.05
next
fx+=.05
next
end sub

sub background3()
'================
single fx,fy,i,st
sys r,g,b,c,x,y
for x=0 to <scr
i=6
st=.02
'st=.05
'st=.1
fy=0
for y=0 to <scr
c=i*(1+cos(fx))+i*(1+cos(fy))
'c and=0xffffff
pixel x,scr-y,c
'i+=1
'i+=32
'i+=145
'i+=0x3ff
'i+=0x1233f
'i+=0x010203
'i+=0x100203
i*=1.0185
i+=.4
fy+=st
next
fx+=st
next
end sub

background3

'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
