'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%% Minibox Demo - 4th January 2003
'%%      Written by Shockwave and Xalthorn.  Their first
'%%      joint effort, hopefully not the last.
'%% 
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
gosub initialise

' %%%%%%%%%%%%%%%%% MAIN ROUTINE %%%%%%%%%%%%%%%%%%%%%%%%%
label main : REM ------------------- The heart of the demo
 setdrawbuf cb : REM -------------------- Flip the buffers
 cb=1-cb : setdispbuf cb 

 qq=mod(qq+6,360) : br=si(qq)*64+96

 clear window     : REM Draw the backdrop
 setrgb 1,0,0,0   : setrgb 2,0,0,br
 setrgb 3,0,0,br
 gtriangle 0,0 to -320,-230 to -320,230
 gtriangle 0,0 to 320,230 to 320,-230
 fill rect -qq,-230,-qq-br,230
 fill rect qq,-230,qq+br,230
 gtriangle 0,0 to -320,230 to 320,230
 gtriangle 0,0 to -320,-230 to 320,-230

 gosub nstars         : REM --------------- Draw the stars
 gosub drawobject     : REM -------------- Draw the object

 setrgb 1,200,200,255 : REM ------------ Draw the scroller
 mx=mx-2              : if mx>-330 goto write
 mx=mx+10             : mpos=mod(mpos+1,mlen)
 label write          : mm$=mid$(m$,mpos,65)
 text mx,250,mm$      : setrgb 1,0,0,0
 text mx+1,251,mm$
 xr=mod(xr+5,360)     : REM - Change the rotation values
 yr=mod(yr+4,360)     
 zr=mod(zr+3,360)
goto main             : REM ------ Go back and start again


' %%%%%%%%%%%%%%%%% STARS ROUTINE %%%%%%%%%%%%%%%%%%%%%%%%
label nstars
 setrgb 1,155,155,255
  for a=1 to nst
   tx=xst(a)/zst(a)
   ty=yst(a)/zst(a)
   s=9-zst(a)
   if tx<-320 or tx>320 or ty<-230 or ty>230 then
    xst(a)=-2000+ran(4000)
    yst(a)=-2000+ran(4000)
    zst(a)=9
   else
    fill rect tx,ty to tx+s,ty+s
   fi
   zst(a)=zst(a)-.2
  next a
return

' %%%%%%%%%%%%%%%%% SETOBJ ROUTINE %%%%%%%%%%%%%%%%%%%%%%%
label setobj            : REM ---------- Prepare an object
 convex=objects(obj,1)  : REM --------- 0=Concave 1=Convex
 np=objects(obj,2)      : nf=objects(obj,3)

 for a=1 to np          : REM ----- Copy the points across
  px(a)=points(obj,a,1) : REM ----- from the object store
  py(a)=points(obj,a,2) : pz(a)=points(obj,a,3)
 next a

 for a=1 to nf            : REM ---- Copy the faces across
  f1(a)=faces(obj,a,1)    : f2(a)=faces(obj,a,2)
  f3(a)=faces(obj,a,3)    : f4(a)=faces(obj,a,4)
  f5(a)=faces(obj,a,8)    : f6(a)=faces(obj,a,9)
  f7(a)=faces(obj,a,10)   : red(a)=faces(obj,a,5)
  green(a)=faces(obj,a,6) : blue(a)=faces(obj,a,7)
 next a

return

' %%%%%%%%%%%%%%%%% DRAWOBJECT ROUTINE %%%%%%%%%%%%%%%%%%%
label drawobject       : REM ------ Draw the actual object
 CX=co(xr)             : SX=si(xr)
 CY=co(yr)             : SY=si(yr)
 CZ=co(zr)             : SZ=si(zr)
 SXY=SX*SY             : CXSY=CX*SY

 m00 = CY*CZ           : m01 = -CY*SZ
 m02 = SY              : m10 = CX*SZ + SXY*CZ
 m11 = CX*CZ - SXY*SZ  : m12 = -SX*CY
 m20 = SX*SZ - CXSY*CZ : m21 = SX*CZ + CXSY*SZ
 m22 = CX*CY           : REM ------ End of the matrix prep

 for p=1 to np         : REM -------- Calculate the points
  x=px(p)              : y=py(p)
  z=pz(p)              : xx=m00*x+m10*y+m20*z
  yy=m01*x+m11*y+m21*z : zz=m02*x+m12*y+m22*z
  zz=zz+zoom           : z=((zz*0.001)+1)
  sx(p)=xx/z           : REM ------------ Store the points
  sy(p)=yy/z           : sz(p)=zz/z
 next p

 fp=0
 for f=1 to nf           : REM --------- Process the faces
  x=f5(f)                : y=f6(f)
  z=f7(f)                : zz=m02*x+m12*y+m22*z

  f10(f)=zz              : fv(f)=999
  if zz>=0 goto skipcalc : REM - if normal is away, ignore

  p1=f1(f)               : p2=f2(f)
  p3=f3(f)               : p4=f4(f)
  x1=sx(p1)              : y1=sy(p1)
  x2=sx(p2)              : y2=sy(p2)
  x3=sx(p3)              : y3=sy(p3)

  v1x=x1-x2              : v1y=y1-y2
  v2x=x3-x2              : v2y=y3-y2
  vi=v1x*v2y-v2x*v1y     : fv(f)=vi

  if vi<=0 goto notvis   : REM --- if invisible, ignore it
  fp=fp+1                : fl(fp)=f
  z1=sz(p1)              : z2=sz(p2)
  z3=sz(p3)              : z4=sz(p4)
  if p4=0 fz(f)=(z1+z2+z3)*0.333
  if p4>0 fz(f)=(z1+z2+z3+z4)*0.25
  label notvis           : REM - We came here if invisible
  label skipcalc         : REM - We came here to skip calc
 next f                  : REM -- End of face calculations

 if convex=1 goto nosort : REM ---- No need to sort convex
 for f=1 to fp-1         : REM ----- Bubble sort the faces
  for a=f to fp
   if fz(fl(f))<fz(fl(a)) then
    t=fl(f) : fl(f)=fl(a)
    fl(a)=t
   fi
  next a
 next f
 label nosort             : REM -- We came here if no sort

 for a=1 to nms
  xo=xs(a) : yo=ys(a)
  t=yo*0.02
  xs(a)=xs(a)*1.05
  ys(a)=ys(a)*1.05
  if abs(xs(a))>500 or abs(ys(a))>400 then
   xs(a)=ran(600)-300
   ys(a)=ran(600)-300
   xs(a)=xs(a)*0.1
   ys(a)=ys(a)*0.1
  fi

  for o=1 to fp            : REM --- Draw the actual faces
   f=fl(o)                 : if fv(f)<=0 goto skipdraw

    p1=f1(f)               : p2=f2(f)
    p3=f3(f)               : p4=f4(f)

    x1=sx(p1)*t+xo         : y1=sy(p1)*t+yo
    x2=sx(p2)*t+xo         : y2=sy(p2)*t+yo
    x3=sx(p3)*t+xo         : y3=sy(p3)*t+yo
    x4=sx(p4)*t+xo         : y4=sy(p4)*t+yo

    b=f10(f)*-200          : rr=red(f)
    gg=green(f)            : bb=blue(f)
    br=(b/10)*(abs(xo)+abs(yo))/30 

    setrgb 1,br*rr,br*gg,br*bb
    fill triangle x1,y1 to x2,y2 to x3,y3
    if p4>0 fill triangle x1,y1 to x3,y3 to x4,y4
    setrgb 1,0,0,0         : line x1,y1 to x2,y2
    line to x3,y3          : if p4>0 line to x4,y4
    line to x1,y1
   label skipdraw          : REM --- No drawing, come here
  next o                   : REM --- Next face in the list
 next a
return

' %%%%%%%%%%%%%%%%% INITIALISE ROUTINE %%%%%%%%%%%%%%%%%%%
label initialise
 open window 640,512 : window origin "cc"
 setrgb 0,0,0,80

 nms=9               : REM Number of boxes
 dim xs(nms),ys(nms)
 for a=1 to nms
  xs(a)=ran(600)-300
  ys(a)=ran(600)-300
 next a

 nst=20              : REM Number of stars
 dim xst(nst),yst(nst),zst(nst)
 for a=1 to nst
  xst(a)=-2000+ran(4000)
  yst(a)=-2000+ran(4000)
  zst(a)=ran(9)
 next a

 colim=3000
 dim co(colim),si(colim) : REM -- Setup Cos and Sin Arrays
 for a=0 to colim
  co(a)=cos(a*(pi/180))   : si(a)=sin(a*(pi/180))
 next a

 restore objectdata     : read mo,mp,mf
 dim objects(mo,3),points(mo,mp,3),faces(mo,mf,10),px(mp)
 dim py(mp),pz(mp),f1(mf),f2(mf),f3(mf),f4(mf),f5(mf)
 dim f6(mf),f7(mf),f8(mf),f9(mf),f10(mf),red(mf),green(mf)
 dim blue(mf),fv(mf),pv(mp),pc(mp),sx(mp),sy(mp),sz(mp)
 dim fz(mf),fl(mf)

 for o=1 to mo           : REM ----- From 1 to Max Objects
  read convex,scale,np   : REM -------- Convex=1 Concave=0
  objects(o,1)=convex    : objects(o,2)=np

  for a=1 to np           : REM -- Read the objects points
   read x,y,z
   points(o,a,1)=x*scale  : points(o,a,2)=y*scale
   points(o,a,3)=z*scale
  next a                  : REM --------------- Next point

  read nf
  objects(o,3)=nf
  for a=1 to nf          : REM ---- Read the objects faces
   for b=1 to 4
    read faces(o,a,b)
   next b

  read b                  : REM -- Grab the colour value
  faces(o,a,5)=and(b,4)/4 : REM -- Extract the red part
  faces(o,a,6)=and(b,2)/2 : REM -- Extract the green part
  faces(o,a,7)=and(b,1)   : REM -- Extract the blue part

  x1=points(o,faces(o,a,1),1): y1=points(o,faces(o,a,1),2)
  z1=points(o,faces(o,a,1),3): x2=points(o,faces(o,a,2),1)
  y2=points(o,faces(o,a,2),2): z2=points(o,faces(o,a,2),3)
  x3=points(o,faces(o,a,3),1): y3=points(o,faces(o,a,3),2)
  z3=points(o,faces(o,a,3),3): x4=points(o,faces(o,a,4),1)
  y4=points(o,faces(o,a,4),2): z4=points(o,faces(o,a,4),3)

' %%%%%%%%%%%%% CALCULATE SURFACE NORMAL %%%%%%%%%%%%%%%%%
  xa=x1-x2                       : ya=y1-y2
  za=z1-z2                       : xb=x3-x2
  yb=y3-y2                       : zb=z3-z2
  xx=yb*za - zb*ya + x2          : yy=xa*zb - xb*za + y2
  zz=xb*ya - xa*yb + z2          : l1=xx-x2
  l2=yy-y2                       : l3=zz-z2
  ul=sqrt(l1*l1 + l2*l2 + l3*l3) : xn=l1/ul
  yn=l2/ul                       : zn=l3/ul

  faces(o,a,8)=xn : REM ---------------- Store face normal
  faces(o,a,9)=yn : faces(o,a,10)=zn

 next a                          : REM --------- Next face
next o                           : REM ------- Next Object

obj=1 : od=800
gosub setobj : REM ---------------- Setup the first object

 for a=1 to 65 : REM ------------------ Setup the scroller
 m$=m$+" " : next a
 m$=m$+"A little demo by Shockwave and Xalthorn, don't "
 m$=m$+"expect much, Shockwave was poorly and Xalthorn "
 m$=m$+"was tired.    "
 m$=m$+"For the record it was nice to watch Xalthorn "
 m$=m$+"coding most of this demo, In fact I contributed "
 m$=m$+"about 10 lines including this scrolltext. "
 m$=m$+"Happy new year... Nick.    "
 m$=m$+"  Don't let him fool you folks, Shocky helped "
 m$=m$+"out a great deal.  It was certainly a fun little "
 m$=m$+"experiment, I just wished we had more time so "
 m$=m$+"that we could have developed more demos.  Anyway "
 m$=m$+"until next time, TTFN folks... Xalthorn     "
 mx=-300 : mlen=len(m$)
return

label objectdata : data 1,31,35
' cube
data 1,10,8,-1,-1,-1,-1,1,-1,1,1,-1,1,-1,-1,-1,-1,1,-1,1
data 1,1,1,1,1,-1,1,6,1,2,3,4,1,8,7,6,5,2,5,6,2,1,3,2,6,7
data 3,4,4,3,7,8,5,5,1,4,8,6

  

