'By Fryer - Please Upload.
'red cube with lighting - R.Fryer

gosub setup

label loop
  gosub db
  gosub control
  gosub rotate
  gosub draw
goto loop

label draw
  for i=1 to mf
    p1=p(i,1)
    p2=p(i,2)
    p3=p(i,3)
if (sx(p2)-sx(p1))*(sy(p3)-sy(p1))-(sx(p3)-sx(p1))*(sy(p2)-sy(p1))>0 goto nopoly
    vx(1,1)=rx(p1)
    vy(1,1)=ry(p1)
    vz(1,1)=rz(p1)
    vx(2,1)=rx(p2)
    vy(2,1)=ry(p2)
    vz(2,1)=rz(p2)
    vx(3,1)=rx(p3)
    vy(3,1)=ry(p3)
    vz(3,1)=rz(p3)
    nvx1=vx(2,1)-vx(1,1)
    nvy1=vy(2,1)-vy(1,1)
    nvz1=vz(2,1)-vz(1,1)
    nvx2=vx(3,1)-vx(1,1)
    nvy2=vy(3,1)-vy(1,1)
    nvz2=vz(3,1)-vz(1,1)
    vx=nvy1*nvz2-nvz1*nvy2
    vy=nvz1*nvx2-nvx1*nvz2
    vz=nvx1*nvy2-nvy1*nvx2
    d=1/sqrt(vx*vx+vy*vy+vz*vz)
    nx=vx*d
    ny=vy*d
    nz=vz*d

    gosub t
label nopoly
  next i
return

label t
  level=level+1
  if level<3 goto nl
vx1=vx(1,level)
vy1=vy(1,level)
vz1=vz(1,level)
vx2=vx(2,level)
vy2=vy(2,level)
vz2=vz(2,level)
vx3=vx(3,level)
vy3=vy(3,level)
vz3=vz(3,level)

dd=1/sqrt(vx1^2+vy1^2+vz1^2)
      pvx=vx1*dd
      pvy=vy1*dd
      pvz=vz1*dd
      dx=vx1-light_x
      dy=vy1-light_y
      dz=vz1-light_z
      d=1/sqrt(dx*dx+dy*dy+dz*dz)
      vx=dx*d
      vy=dy*d
      vz=dz*d
      s=(vx*nx+vy*ny+vz*nz)*2
      dx=nx*s-vx
      dy=ny*s-vy
      dz=nz*s-vz
      d=1/sqrt(dx*dx+dy*dy+dz*dz)
      vv=(vx1*nx+vy1*ny+vz1*nz)*dd
      h=pvx*dx+pvy*dy+pvz*dz
      h1=192*max(h*d,0)
      s1=s/2*vv+ambient

dd=1/sqrt(vx2^2+vy2^2+vz2^2)
      pvx=vx2*dd
      pvy=vy2*dd
      pvz=vz2*dd
      dx=vx2-light_x
      dy=vy2-light_y
      dz=vz2-light_z
      d=1/sqrt(dx*dx+dy*dy+dz*dz)
      vx=dx*d
      vy=dy*d
      vz=dz*d
      s=(vx*nx+vy*ny+vz*nz)*2
      dx=nx*s-vx
      dy=ny*s-vy
      dz=nz*s-vz
      d=1/sqrt(dx*dx+dy*dy+dz*dz)
      vv=(vx2*nx+vy2*ny+vz2*nz)*dd
      h=pvx*dx+pvy*dy+pvz*dz
      h2=192*max(h*d,0)
      s2=vv*s/2+ambient

dd=1/sqrt(vx3^2+vy3^2+vz3^2)
      pvx=vx3*dd
      pvy=vy3*dd
      pvz=vz3*dd
      dx=vx3-light_x
      dy=vy3-light_y
      dz=vz3-light_z
      d=1/sqrt(dx*dx+dy*dy+dz*dz)
      vx=dx*d
      vy=dy*d
      vz=dz*d
      s=(vx*nx+vy*ny+vz*nz)*2
      dx=nx*s-vx
      dy=ny*s-vy
      dz=nz*s-vz
      d=1/sqrt(dx*dx+dy*dy+dz*dz)
      vv=(vx3*nx+vy3*ny+vz3*nz)*dd
      h=pvx*dx+pvy*dy+pvz*dz
      h3=192*max(h*d,0)
      s3=s/2*vv+ambient


    z=600/vz1
    sx1=vx1*z
    sy1=vy1*z
    z=600/vz2
    sx2=vx2*z
    sy2=vy2*z
    z=600/vz3
    sx3=vx3*z
    sy3=vy3*z
    setrgb 1,255*s1+h1,h1,h1
    setrgb 2,255*s2+h2,h2,h2
    setrgb 3,255*s3+h3,h3,h3
    gtriangle sx1,sy1 to sx2,sy2 to sx3,sy3
    goto n
label nl
    vx(4,level)=(vx(1,level)+vx(2,level))/2
    vy(4,level)=(vy(1,level)+vy(2,level))/2
    vz(4,level)=(vz(1,level)+vz(2,level))/2
    vx(5,level)=(vx(2,level)+vx(3,level))/2
    vy(5,level)=(vy(2,level)+vy(3,level))/2
    vz(5,level)=(vz(2,level)+vz(3,level))/2
    vx(6,level)=(vx(3,level)+vx(1,level))/2
    vy(6,level)=(vy(3,level)+vy(1,level))/2
    vz(6,level)=(vz(3,level)+vz(1,level))/2
    vx(1,1+level)=vx(1,level)
    vy(1,1+level)=vy(1,level)
    vz(1,1+level)=vz(1,level)
    vx(2,1+level)=vx(4,level)
    vy(2,1+level)=vy(4,level)
    vz(2,1+level)=vz(4,level)
    vx(3,1+level)=vx(6,level)
    vy(3,1+level)=vy(6,level)
    vz(3,1+level)=vz(6,level)
    gosub t
    vx(1,1+level)=vx(5,level)
    vy(1,1+level)=vy(5,level)
    vz(1,1+level)=vz(5,level)
    gosub t
    vx(3,1+level)=vx(2,level)
    vy(3,1+level)=vy(2,level)
    vz(3,1+level)=vz(2,level)
    gosub t
    vx(2,1+level)=vx(3,level)
    vy(2,1+level)=vy(3,level)
    vz(2,1+level)=vz(3,level)
    vx(3,1+level)=vx(6,level)
    vy(3,1+level)=vy(6,level)
    vz(3,1+level)=vz(6,level)
    gosub t
label n  
  level=level-1
return

label control
  a=mod(a+3,360)
  b=mod(b+2,360)
  c=mod(c+1,360)
return

label setup
  open window 640,512
  window origin "CC"
  read mp,mf
  dim vx(10,10),vz(10,10),vy(10,10)
  dim tx(10,10),ty(10,10)
  dim r(100,100,6),b(100,100,6),g(100,100,6)
  dim sx(mp),sy(mp)
  dim x(mp),y(mp),z(mp),p(mf,3),tex(mf),face(mf)
  dim rx(mp),ry(mp),rz(mp)
  dim sn(360),cs(360)
  for i=0 to 360
    cs(i)=cos(i/180*pi)
    sn(i)=sin(i/180*pi)
  next i
  for y=0 to 31
    for x=0 to 31
      r(x,y,1)=255*and(x+y,1)
      g(x,y,1)=255*and(x,1)
      b(x,y,1)=255*and(y,1)
      r(x,y,2)=255*and(x+y,1)
      g(x,y,2)=255*and(x+y,1)
      b(x,y,2)=255*and(x+y,1)
      r(x,y,3)=100+100*sn(mod(y*40,360))*cs(mod(x*50,360))
      g(x,y,3)=0
      b(x,y,3)=150
      r(x,y,4)=rm+ran(250)
      g(x,y,4)=gm+ran(250)
      b(x,y,4)=bm+ran(250)
      r(x,y,5)=100+100*sn(mod(y*60,360))*cs(mod(x*70,360))
      g(x,y,5)=100+100*sn(mod(y*90,360))*cs(mod(x*20,360))
      b(x,y,5)=0
      r(x,y,6)=100+100*sn(mod(y*60,360))*cs(mod(x*70,360))
      g(x,y,6)=0
      b(x,y,6)=255*and(x,1)
    next x
  next y
  for i=1 to mp
    read x(i),y(i),z(i)
  next i
  for i=1 to mf
    read p(i,1),p(i,2),p(i,3),tex(i),face(i)
  next i
  a=0
  b=0
  c=0
  ambient=.1
'  light_x=400
'  light_y=100
'  light_z=300
return

label db
  setdispbuf db
  db=1-db
  setdrawbuf db
  clear window
return

label rotate
  csa=cs(a):sna=sn(a)
  csb=cs(b):snb=sn(b)
  csc=cs(c):snc=sn(c)
  for i=1 to mp
    tz=z(i)*csa+x(i)*sna
    tx=x(i)*csa-z(i)*sna
    rx=tx*csb+y(i)*snb
    ty=y(i)*csb-tx*snb
    rz=500+tz*csc-ty*snc
    ry=ty*csc+tz*snc
    z=600/rz
    sx(i)=rx*z
    sy(i)=ry*z
    rx(i)=rx
    ry(i)=ry
    rz(i)=rz
  next i
return

data 8,12
data -100,-100,-100
data -100,-100,100
data 100,-100,100
data 100,-100,-100
data -100,100,-100
data -100,100,100
data 100,100,100
data 100,100,-100

data 1,2,6,1,1,6,5,1,1,2
data 2,3,7,2,1,7,6,2,2,2
data 3,4,8,3,1,8,7,3,3,2
data 4,1,5,4,1,5,8,4,4,2
data 5,6,7,5,1,7,8,5,5,2
data 1,4,3,6,1,3,2,1,6,2











