gosub initialise
gosub main
exit

label main
 repeat
  gosub flipscreen
  clear window
  gosub resetarrays
  gosub rotatepoints
  gosub calclight
  gosub lightposition
  gosub rotchange
 until (1=2)
return

rem #####################################################
label resetarrays
 for a=1 to nf
  fv(a)=0
 next a

 for a=1 to np
  pv(a)=0
  pc(a)=0
 next a
return

rem #####################################################
label rotchange
 xr=mod(xr+xrc,360)
 yr=mod(yr+yrc,360)
 qq=mod(qq+2,360)
return

rem #####################################################
label flipscreen
 setdispbuf cb
 cb=1-cb
 setdrawbuf cb
return

rem #####################################################
label rotatepoints
 for p=1 to np
  xx=px(p) : y=py(p) : z=pz(p)
  yy=y*co(xr)+z*si(xr)
  zz=z*co(xr)-y*si(xr)
  x=xx*co(yr)-zz*si(yr)
  z=xx*si(yr)+zz*co(yr)
  zz=z+si(qq)*300
  x=x/((zz/focus)+1)
  yy=yy/((zz/focus)+1)
  sx(p)=x : sy(p)=yy : sz(p)=zz
 next p
return

rem #####################################################
label calclight
 for f=1 to nf
  gosub getface
  v1x=x1-x2 : v1y=y1-y2
  v2x=x3-x2 : v2y=y3-y2
  vi=v1x*v2y-v2x*v1y
  fv(f)=vi
  pv(p1)=pv(p1)+vi : pc(p1)=pc(p1)+1
  pv(p2)=pv(p2)+vi : pc(p2)=pc(p2)+1
  pv(p3)=pv(p3)+vi : pc(p3)=pc(p3)+1
 next f
return

label lightposition
 xx=-px(11) : yy=-py(11) : z=pz(11)
 xxr=360-xr : yyr=360-yr
 x=xx*co(yyr)-z*si(yyr)
 zz=xx*si(yyr)+z*co(yyr)
 y=yy*co(xxr)+zz*si(xxr)
 z=zz*co(xxr)-y*si(xxr)
 if z>2 then
  gosub drawlight
  gosub drawobject
 else
  gosub drawobject
  gosub drawlight
 fi
return

label drawobject
 for f=1 to nf
  gosub getface
  x1=px(p1) : y1=py(p1) : z1=pz(p1) : c1=-z1
  x2=px(p2) : y2=py(p2) : z2=pz(p2) : c2=-z2
  x3=px(p3) : y3=py(p3) : z3=pz(p3) : c3=-z3
  if z1<0 or z2<0 or z3<0 then
   v1=pv(p1)/(pc(p1)*80)
   v2=pv(p2)/(pc(p2)*80)
   v3=pv(p3)/(pc(p3)*80)
   setrgb 1,c1+v1,c1,0
   setrgb 2,c2+v2,c2,0
   setrgb 3,c3+v3,c3,0
   gtriangle x1,y1 to x2,y2 to x3,y3
  fi
 next f
return

label drawlight
 b=-z+60
 setrgb 1,b,0,0
 setrgb 2,b/4,0,0
 setrgb 3,b/4,0,0
 r=b/6
 gosub drawball
return

label drawball
 n=0
 repeat
  x1=co(n)*r    : y1=si(n)*r
  x2=co(n+10)*r : y2=si(n+10)*r
  gtriangle x,y to x+x1,y+y1 to x+x2,y+y2
  gtriangle x,y to x-x1,y+y1 to x-x2,y+y2
  gtriangle x,y to x-x1,y-y1 to x-x2,y-y2
  gtriangle x,y to x+x1,y-y1 to x+x2,y-y2
  n=n+10
 until (n>90)
return

rem #####################################################
label getface
 p1=f(f,1) : p2=f(f,2) : p3=f(f,3)
 x1=sx(p1) : y1=sy(p1) : z1=sz(p1)
 x2=sx(p2) : y2=sy(p2) : z2=sz(p2)
 x3=sx(p3) : y3=sy(p3) : z3=sz(p3)
return

label initialise
 open window 640,512
 window origin "cc"

 focus=1000

 dim co(360),si(360)
 f=pi/180
 for a=0 to 360
  co(a)=cos(a*f)
  si(a)=sin(a*f)
 next a

 xrc=1:yrc=2

 read np
 dim px(np),py(np),pz(np)
 dim pv(np),pc(np),sx(np),sy(np),sz(np)
 for a=1 to np
  read px(a),py(a),pz(a)
  px(a)=px(a)*50
  py(a)=py(a)*50
  pz(a)=pz(a)*50
 next a

 read nf
 dim f(nf,3),fv(nf)
 for a=1 to nf
  for b=1 to 3
   read f(a,b)
  next b
 next a
return

label pointdata
data 11
data -1,0,2,1,0,2,2,0,1,2,0,-1,1,0,-2,-1,0,-2,-2,0,-1,-2
data 0,1,0,2,0,0,-3,0,0,0,-4

label facedata
data 16
data 1,2,9,2,3,9,3,4,9,4,5,9,5,6,9,6,7,9,7,8,9,8,1,9,1,8
data 10,8,7,10,7,6,10,6,5,10,5,4,10,4,3,10,3,2,10,2,1,10

