' CelGem
'  A Cel Shaded Rotating Gem Demo
'  Copyright (c) Marc Gale (Xalthorn) 2002

gosub initialise
gosub main
exit

rem #####################################################
label main
 repeat
  gosub flipscreen
  clear window
  gosub colourcycle
  gosub drawbackground
  gosub resetarrays
  gosub rotatepoints
  gosub calclight
  gosub drawoutline
  gosub drawfaces
  gosub rotchange
 until (1=2)
return

rem #####################################################
label colourcycle
 cd=mod(cd+1,300)
 if cd=0 cc=mod(cc+1,7)
return

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

rem #####################################################
label drawfaces
 for f=1 to nf
  gosub getface
  if fv(f)>0 then 
   gosub getvisible
   b=(v1+v2+v3)/3
   rr=min(1,and(cc+1,1))
   gg=min(1,and(cc+1,2))
   bb=min(1,and(cc+1,4))
   setrgb 1,b*rr,b*gg,b*bb
   fill triangle x1,y1 to x2,y2 to x3,y3
   setrgb 1,0,0,0
   triangle x1,y1 to x2,y2 to x3,y3
  fi
 next f
return

rem #####################################################
label drawoutline
 m=1.03
 setrgb 1,255,255,255
 for f=1 to nf
  gosub getface
  if fv(f)>0 then
   gosub getvisible
   fill triangle x1*m,y1*m to x2*m,y2*m to x3*m,y3*m
  fi
 next f
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

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 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 drawbackground
 for y=-250 to 150 step 100
  for x=-300 to 200 step 100
   setrgb 1,100,100,150
   fill rect x,y to x+95,y+95
  next x
 next y
return

rem #####################################################
label flipscreen
 setdispbuf cb
 cb=1-cb
 setdrawbuf cb
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

rem #####################################################
label getvisible
 v1=pv(p1)/(pc(p1)*80)
 v2=pv(p2)/(pc(p1)*80)
 v3=pv(p3)/(pc(p1)*80)
return

rem #####################################################
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

 restore pointdata
 read np
 dim px(np),py(np),pz(np)
 for a=1 to np
  read x,y,z
  px(a)=x*50
  py(a)=y*50
  pz(a)=z*50
 next a

 restore facedata
 read nf
 dim f(nf,3)
 for a=1 to nf
  for b=1 to 3
   read f(a,b)
  next b
 next a

 dim fv(nf),pv(np),pc(np),sx(np),sy(np),sz(np)
return

label pointdata
data 10
data -1,0,2,1,0,2,2,0,1,2,0,-1,1,0,-2,-1,0,-2,-2,0,-1
data -2,0,1,0,2,0,0,-3,0

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
data 1,8,10,8,7,10,7,6,10,6,5,10,5,4,10,4,3,10,3,2,10
data 2,1,10



