' %%%%%%% Multi3D Demo by Marc Gale (Xalthorn) %%%%%%%%%%%
' %%   Written for the 300 line demo competition set    %%
' %%   by Shockwave and held on the Yabasic Bulletin    %%
' %%   Boards (pub51.ezboard.com/byabasicprogramming)   %%
' %%                                                    %%
' %%        Download from www.ps2-yabasic.co.uk         %%
' %%%%%%%%%%%%%%%%% INITIALISATION %%%%%%%%%%%%%%%%%%%%%%%
open window 640,512 : window origin "cc"
setrgb 0,100,100,150
for a=0 to 1    : REM ----------------- Setup both buffers
 setdrawbuf a   : clear window
 setrgb 1,0,0,0 : rect -205,-205,205,205

 for b=1 to 2   : REM ---------------- Draw the 'XAL' logo
  if b=2 setrgb 1,200,200,255
  if b=1 then f=20 else f=0 fi
  fill triangle -310,-160+f to -290,-180+f to -230,-60
  fill triangle -240,-180+f to -220,-160+f to -300,-60
  fill triangle -310,40+f/2 to -290,60 to -265,-50+f
  fill triangle -240,60 to -220,40+f/2 to -265,-50+f
  fill rect -290,f/2,-240,20+f/2
  fill triangle -265,80+f to -300,160+f/2 to -280,190
  fill triangle -300,160+f/2 to -280,190 to -230,160+f/2
 next b
next a

dim co(720),si(720)    : REM ---- Setup Cos and Sin Arrays
for a=0 to 720
 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$+"Welcome to my first attempt at the 300 line demo "
m$=m$+"competition.  Hidden inside this demo is my attemp"
m$=m$+"t at the record for the most complicated non-conve"
m$=m$+"x 3D object drawn in realtime with lighting and st"
m$=m$+"uff.  Anyway, I hope you enjoy the demo, god knows"
m$=m$+" it was awkward to keep running at 50fps. It's ama"
m$=m$+"zing how much difference can be made by simply cha"
m$=m$+"nging the size of an array or two. Also, never, ev"
m$=m$+"er use arrays with more than one dimension in the "
m$=m$+"inner loop of your demos, it just kills them. Back"
m$=m$+" to the demo now, I make no excuse for the logo, I"
m$=m$+"'m no artist. You can download this demo and more "
m$=m$+"like it at my website (www.ps2-yabasic.co.uk). Now"
m$=m$+" for some greetings in no order: Daisy, Kieran, Sh"
m$=m$+"ockwave, Rafryer, Parabellum, Jinx, Jim Shaw, and "
m$=m$+"everyone else at the Yabasic bulletin boards (pub5"
m$=m$+"1.ezboard.com/byabasicprogramming) see you all the"
m$=m$+"re later. I think it's time for this scroller to l"
m$=m$+"oop now, see you at the beginning in a mo."
mx=-300 : mlen=len(m$)

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

 clear fill rect -320,235,320,260 : REM --------- 3D Panel
 setrgb 1,150,150,200 : fill rect -200,-200,200,200
 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          : text mx,250,mid$(m$,mpos,65)

 if dir=0 od=od-1     : if od<0 dir=500
 zoom=zoom+dir        : REM --- Move the object in and out
 if zoom<=0 dir=0
 if zoom>80000 then
  dir=-500            : od=800
  obj=obj+1           : if obj>mo obj=1
  gosub setobj        : REM ---- Get the next object ready
 fi
 xr=mod(xr+1,360)     : REM - Change the rotation values
 yr=mod(yr+2,360)     : zr=mod(zr+1,360)
goto main             : REM ------ Go back and start again

' %%%%%%%%%%%%%%%%% 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

 for a=0 to 1           : REM -- Display point/face values
  setdrawbuf a          : clear fill rect -200,215,200,240
  x=-150                : y=230
  t$="Points: "+str$(np)+"          Faces: "+str$(nf)
  setrgb 1,0,0,0
  for xx=x-1 to x+1 step 2
   for yy=y-1 to y+1 step 2
    text xx,yy,t$
   next yy
  next xx
  setrgb 1,255,255,255  : text x,y,t$
 next a                 : REM ---------------- Next buffer
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 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)              : y1=sy(p1)  
   x2=sx(p2)              : y2=sy(p2)  
   x3=sx(p3)              : y3=sy(p3)  
   x4=sx(p4)              : y4=sy(p4)  

   b=f10(f)*-200          : rr=red(f)
   gg=green(f)            : bb=blue(f)
   setrgb 1,b*rr,b*gg,b*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
return

label objectdata : data 5,31,35
' cube
data 1,110,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
' gem
data 1,30,10,-2,0,4,2,0,4,4,0,2,4,0,-2,2,0,-4,-2,0,-4,-4,0
data -2,-4,0,2,0,4,0,0,-6,0,16,1,2,9,0,4,2,3,9,0,4
data 3,4,9,0,4,4,5,9,0,4,5,6,9,0,4,6,7,9,0,4
data 7,8,9,0,4,8,1,9,0,4,1,8,10,0,4,8,7,10,0
data 4,7,6,10,0,4,6,5,10,0,4,5,4,10,0,4,4
data 3,10,0,4,3,2,10,0,4,2,1,10,0,4
' magic box
data 0,35,24,-1,1,-1,1,1,-1,-1,-1,-1,1,-1,-1,-2,2,-2,2,2
data -2,-2,-2,-2,2,-2,-2,-3,3,-3,3,3,-3,-3,-3,-3,3,-3,-3
data -1,1,1,1,1,1,-1,-1,1,1,-1,1,-2,2,2,2,2,2,-2,-2,2,2,-2
data 2,-3,3,3,3,3,3,-3,-3,3,3,-3,3,30,1,5,6,2,1,3,7,5,1,1
data 2,6,8,4,1,4,8,7,3,1,5,9,10,6,2,7,11,9,5,2,6,10,12,8,2
data 8,12,11,7,2,1,2,4,3,7,13,15,16,14,7,14,18,17,13,1,16
data 20,18,14,1,15,19,20,16,1,13,17,19,15,1,21,17,18,22,2
data 21,23,19,17,2,19,23,24,20,2,22,18,20,24,2,9,21,17,5,4
data 9,5,6,10,4,10,6,18,22,4,22,18,17,21,4,5,17,18,6,3,8,7
data 11,12,4,12,24,20,8,4,23,11,7,19,4,20,24,23,19,4,7,8
data 20,19,3,9,11,23,21,1,12,10,22,24,1
' Onion (don't blame me, I didn't name it)
data 0,55,25,0,0,0,1,3,-1,-3,1,-1,-1,1,-3,1,1,-3,3,1,-1,-3
data -1,-1,-1,-1,-3,1,-1,-3,3,-1,-1,-1,-3,-1,1,-3,-1,-1,3
data -1,-1,3,1,1,3,1,-3,1,1,-1,1,3,1,1,3,3,1,1,-3,-1,1,-1
data -1,3,1,-1,3,3,-1,1,-1,-3,1,1,-3,1,34,3,13,4,0,1,13,2
data 5,4,4,5,2,6,0,1,7,3,4,8,4,8,4,5,9,5,9,5,6,10,4,7,8,11
data 0,1,11,8,9,12,4,12,9,10,0,1,2,13,1,0,2,13,3,1,0,6,3,7
data 1,0,2,7,11,1,0,6,11,12,1,0,2,12,10,1,0,6,10,6,1,0,2,6
data 2,1,0,6,19,15,18,0,1,18,15,14,17,4,17,14,16,0,1,23,19
data 18,22,4,22,18,17,21,5,21,17,16,20,4,23,22,25,0,1,25
data 22,21,24,4,24,21,20,0,1,16,14,1,0,6,1,14,15,0,2,1,15
data 19,0,6,19,23,1,0,2,23,25,1,0,6,25,24,1,0,2,24,20,1,0
data 6,20,16,1,0,2
' A sort of distorted cross
data 0,45,29,-1,3,-1,1,3,-1,-1,2,-1,1,2,-1,0,0,0,-1,-2,-1
data 1,-2,-1,-1,-4,-1,1,-4,-1,-1,4,1,1,4,1,-1,2,1,1,2,1,-1
data -2,1,1,-2,1,-1,-3,1,1,-3,1,2,1,-1,3,1,-1,2,-1,-1,3,-1
data -1,2,1,1,3,1,1,2,-1,1,3,-1,1,-2,1,-1,-2,-1,-1,-2,1,1
data -2,-1,1,32,3,1,2,4,4,4,2,11,13,4,13,11,10,12,4,12,10
data 1,3,4,1,10,11,2,4,8,6,7,9,2,9,7,15,17,2,16,14,6,8,2
data 17,15,14,16,2,16,8,9,17,2,5,3,4,0,6,5,4,13,0,6,5,12,3
data 0,6,5,13,12,0,6,6,5,7,0,6,7,5,15,0,6,14,5,6,0,6,15,5
data 14,0,6,5,18,20,0,6,5,22,18,0,6,5,20,24,0,6,5,24,22,0
data 6,20,18,19,21,1,25,23,22,24,1,21,19,23,25,1,18,22,23
data 19,1,24,20,21,25,1,27,26,5,0,6,5,26,28,0,6,5,29,27,0
data 6,5,28,29,0,6,29,28,26,27,6



