'#########################################################
'##
'## "Yet Another Cube Demo"
'##                     (and yet another stupid demo name)
'##
'## By Franck Chevassu (aka. Parabellum)  ---  August 2002
'##
'## Feel free to use any part of this code for your own
'## creations (Some greetings will do! ;)
'##
'#########################################################

S$="  PARABELLUM\n\n... is pleased\nto present his\nlates"
S$=S$+"t demo...\n\n\nThis time it's\nsome 3D stuff!\n\nY"
S$=S$+"ou can change\nthe rendering\nusing the  and\n  ke"
S$=S$+"ys of your\ngamepad.\n\n\nAs always,\ngreetings to"
S$=S$+"\nthe people on\nthe YAB board.\n\nSee you!\nEnjoy"
S$=S$+"..."

open window 640,512 : window origin "cc"

'====== LOGO =============================================
'
' This part initialises the arrays used to draw the logo.

dim letter(9,13)
dim pbl(11,2)

data 3, 1,0, 3,6, 4,3, 2,2
data 3, 1,0, 3,6, 4,0, 2,2
data 4, 1,0, 3,6, 4,4, 2,3, 4,0
data 5, 1,0, 3,6, 4,4, 2,3, 4,0, 1,0
data 3, 4,0, 1,0, 3,6, 4,4
data 1, 2,3, 3,3
data 2, 3,0, 1,0, 3,6
data 3, 4,6, 4,0, 1,0, 2,3
data 4, 1,0, 3,6, 3,4, 4,5, 4,0

data 1,0.9, 2,1,    3,1, 2,1, 4,1, 5,0, 6,1
data 7,0.8, 7,0.75, 8,1, 9,0

for letter=1 to 9
  read lines
  letter(letter,0) = lines
  for lineNb=1 to 2*lines+2 step 2
    read coord : letter(letter,lineNb)   = -14.6*coord
    read coord : letter(letter,lineNb+1) = -14.6*coord
  next
next

for letter=1 to 11
  read pbl(letter,1), spacing
  pbl(letter,2) = spacing * 14.6 * 4.5 * 0.8
next

coord=0 : spacing=0 : lines=0

'====== VARIABLES DECLARATION ============================

iz  = 200
prm = -325
in  = 1        REM -- Set this to "0" to skip the intro...
C   = 0.81     REM -- Color darkness factor (for history)
A   = 10       REM -- Number of history traces + 1

dim S(5760),C(5760)  REM -- Sin/Cos (resolution: 1/16 deg)
for i=0 to 5760
  S(i) = sin(i * PI/2880)
  C(i) = cos(i * PI/2880)
next

mult=120             REM -- Main cube dimension multiplier

                     REM -- main object XYZ rotation speed 
RX =16*0.96  :  RY =16*1.32  :  RZ =16*0.60
                     REM -- sub objects XYZ rotation speed
RX2=16*1.34  :  RY2=16*1.66  :  RZ2=16*2.04

dim col(A,7,3)       REM -- R,G,B for faces in history
dim R(7),G(7),B(7)   REM -- (Optim) RGB for current faces

dim o1(6,4)          REM -- Object 1 faces
dim o2(8,3)          REM -- Object 2 faces
dim o3(12,3)         REM -- Object 3 faces

dim px(8),  py(8),  pz(8)
dim px2(6), py2(6), pz2(6)
dim px3(8), py3(8), pz3(8)
dim tX(8),  tY(8)

HIST=8*A             REM -- History buffer size
dim hX(HIST), hY(HIST), hP(HIST)
dim ntX(8), ntY(8)

dim itX(8),  itY(8),  itZ1(8), itP(6)
dim itX2(6), itY2(6), itZ2(6), itP2(8)
dim itX3(8), itY3(8), itZ3(8), itP3(12)

'====== OBJECT 1 (CUBE) VERTEX DATA ======================

data  1, 1, 1
data  1,-1, 1
data -1,-1, 1
data -1, 1, 1
data  1, 1,-1
data  1,-1,-1
data -1,-1,-1
data -1, 1,-1
for i=1 to 8
  read px(i),py(i),pz(i)
next

'====== OBJECTS 2/3 VERTEX DATA ==========================

data -1, 0,-1
data  1, 0,-1
data  1, 0, 1
data -1, 0, 1
data  0, 1, 0
data  0,-1, 0
for i=1 to 6
  read px2(i),py2(i),pz2(i)
  px3(i)=px2(i)
  py3(i)=py2(i)
  pz3(i)=pz2(i)
next

'====== OBJECT 3 VERTEX DATA =============================

px3(7)=0 : py3(7)=0 : pz3(7)=1
px3(8)=0 : py3(8)=0 : pz3(8)=-1
for i=0 to 5
  px3(i+1) = C(i * 16*60)
  py3(i+1) = S(i * 16*60)
  pz3(i+1) = 0
next

'====== OBJECT 1/3 CONNECTION DATA =======================

data 1,2,3,4
data 2,1,5,6
data 1,4,8,5
data 4,3,7,8
data 3,2,6,7
data 8,7,6,5
for f=1 to 6
  for vx=1 to 4
    read o1(f,vx)    REM -- Fill object 1 faces
  next               REM -- Fill object 3 faces                     
  o3(f,1)=f     :  o3(f,2)=7   :  o3(f,3)=mod(f,6)+1
  o3(f+6,1)=7-f :  o3(f+6,2)=8 :  o3(f+6,3)=mod(11-f,6)+1
next

'====== OBJECT 2 CONNECTION DATA =========================

data 1,2,5
data 2,1,6
data 2,3,5
data 3,2,6
data 1,5,4
data 1,4,6
data 3,4,5
data 4,3,6
for f=1 to 8 : for vx=1 to 3
  read o2(f,vx)    REM -- Fill object 2 faces
next : next

'====== COLOURS SETUP ====================================

data 170,100,100
data 150,150,100
data 100,100,180
data 100,180,100
data  80,130, 90
data 100,150,200
data 150,150,150

for f=1 to 7
  read R(f),G(f),B(f)
  col(1,f,1)=R(f) : col(1,f,2)=G(f) : col(1,f,3)=B(f)
  for i=1 to 3
    col(A,f,i) = C * col(1,f,i)
    for a=A-1 to 2 step -1
      col(a,f,i) = C * col(a+1,f,i)
    next
  next
next

'====== RENDERING SWITCHES ===============================

cel=1          REM -- Cel Shading activated(1) or not(0) ?
mode=1         REM -- Gouraud (1) or Flat (0) shading ?

'====== MAIN LOOP ========================================

LABEL loop

'--- Swap display & work buffers
setdispbuf DB
DB = 1-DB
setdrawbuf DB

'--- Handle gamepad keys
if port<>peek("port1") gosub handleKey

'--- Clear background
gosub background

'--- Compute sub-objects X,Y,Z rotation angles
rX2 = mod( rX2+RX2, 5760 )
rY2 = mod( rY2+RY2, 5760 )
rZ2 = mod( rZ2+RZ2, 5760 )

'--- Setup vars, and compute the transformation matrix
CX=C(rX2) : SX=S(rX2)    REM -- rX2 angle cosinus/sinus
CY=C(rY2) : SY=S(rY2)    REM -- rY2 angle cosinus/sinus
CZ=C(rZ2) : SZ=S(rZ2)    REM -- rZ2 angle cosinus/sinus
gosub matrix

'--- Setup translation variables
dx = SZ * 0.6            REM -- horizontal translation
dy = CY * 0.21           REM -- vertical translation
dz = 1.22 + SX * 0.22    REM -- depth translation

'--- Apply transformation for each sub-objects vertex
for p=1 to 8
' --- Sub object 1 (8 vertices)
  X=px(p) : Y=py(p) : Z=pz(p)
  z       = (m02*X + m12*Y + m22*Z + 1)
  itX(p)  = (m00*X + m10*Y + m20*Z) / z
  itY(p)  = (m01*X + m11*Y + m21*Z) / z
  itZ1(p) = 1 - (z-0.75) * 2.4      REM -- For lightening
' --- Sub object 2 (6 vertices)
  if p<7 then
    X=px2(p): Y=py2(p): Z=pz2(p)
    z       = (m02*X + m12*Y + m22*Z + 1)
    itX2(p) = (m00*X + m10*Y + m20*Z) / z
    itY2(p) = (m01*X + m11*Y + m21*Z) / z
    itZ2(p) = 1 - (z-0.75) * 2.4    REM -- For lightening
  fi
' --- Sub object 3 (8 vertices)
  X=px3(p): Y=py3(p): Z=pz3(p)
  z       = (m02*X + m12*Y + m22*Z + 1)
  itX3(p) = (m00*X + m10*Y + m20*Z) / z
  itY3(p) = (m01*X + m11*Y + m21*Z) / z
  itZ3(p) = 1 - (z-0.75) * 2.4      REM -- For lightening
next

'--- Compute cross product for object 3 faces
for f=1 to 12
  f2 = o3(f,2)
  itP3(f) = (itX3(o3(f,1))-itX3(f2)) * (itY3(o3(f,3))-itY3(f2)) - (itY3(o3(f,1))-itY3(f2)) * (itX3(o3(f,3))-itX3(f2))
next

'--- Compute main cube X,Y,Z rotation angles
rX = mod( rX+RX, 5760 )
rY = mod( rY+RY, 5760 )
rZ = mod( rZ+RZ, 5760 )

'--- Intro stuff (intro is ON as long as in<>0)
if in>0 gosub preIntro

'--- Setup vars, and compute the transformation matrix
CX=C(rX) : SX=S(rX)
CY=C(rY) : SY=S(rY)
CZ=C(rZ) : SZ=S(rZ)
gosub matrix

'--- Advance history index
H = mod( H+8, HIST)

FOR p=1 to 8 rem -----------------------------------------

' --- Compute cross product for object 1 faces (6 faces)
  if p<7 then
    f2 = o1(p,2)
    itP(p) = (itX(o1(p,1))-itX(f2)) * (itY(o1(p,3))-itY(f2)) - (itY(o1(p,1))-itY(f2)) * (itX(o1(p,3))-itX(f2))
  fi

' --- Compute cross product for object 2 faces (8 faces)
  f2 = o2(p,2)
  itP2(p) = (itX2(o2(p,1))-itX2(f2)) * (itY2(o2(p,3))-itY2(f2)) - (itY2(o2(p,1))-itY2(f2)) * (itX2(o2(p,3))-itX2(f2))
  
' --- Apply transformation for main cube vertices
  X=px(p): Y=py(p): Z=pz(p)
  z       = (m02*X + m12*Y + m22*Z + dz) / mult
  tX(p)   = (m00*X + m10*Y + m20*Z + dx) / z + introX
  tY(p)   = (m01*X + m11*Y + m21*Z + dy) / z

' --- Record the transformed vertex coords in history
  hX(H+p) = tX(p)
  hY(H+p) = tY(p)

NEXT rem -------------------------------------------------

'--- Draw history cubes (oldest first -> darkest first)
h = H
for i=2 to A           REM -- There are (A-1) elts (cubes)
  h = mod( h+8, HIST)  REM -- Advance/wrap around history
  for f=1 to 6         REM -- Each cube has 6 faces
    if hP(h+f)<0 then  REM -- Back face culling
      v1=h+o1(f,1) : v2=h+o1(f,2)
      v3=h+o1(f,3) : v4=h+o1(f,4)
      setrgb 1, col(i,f,1), col(i,f,2), col(i,f,3)
      fill triangle hX(v1),hY(v1) to hX(v2),hY(v2) to hX(v3),hY(v3)
      fill triangle hX(v3),hY(v3) to hX(v4),hY(v4) to hX(v1),hY(v1)
    fi
  next
next

'--- For each face of the main cube...
for f=1 to 6
  f1 = o1(f,1): f2 = o1(f,2) : f3 =o1(f,3) : f4 =o1(f,4)
  x1 = tX(f1) : y1 = tY(f1)
  x2 = tX(f2) : y2 = tY(f2)
  x3 = tX(f3) : y3 = tY(f3)
' --- Check cross product to know if face is visible
  if (x1-x2) * (y3-y2) - (x3-x2) * (y1-y2) >= 0 then
    hP(H+f) = 0     REM -- This face is not visible
  else
    hP(H+f) = -1    REM -- This face is visible
'   --- Draw that face
    setrgb 1, R(f),G(f),B(f)
    fill triangle x1,y1 to x2,y2 to x3,y3
    fill triangle x1,y1 to x3,y3 to tX(f4),tY(f4)
'   --- Draw its sub-obj content (if intro mode allows it)
    if in=0 or in>4 then
      if f=1 or f=6 then         REM -- Face 1/6 => obj 2
        d2 = pz(o1(f,1))
        d0=d2*m20+dx : d1=d2*m21+dy : d2=d2*m22+dz
'       --- Project the vertices onto the cube face
        for p=1 to 6
          X = itX2(p) * 0.58823
          Y = itY2(p) * 0.58823
          z      = (m02*X + m12*Y + d2) / mult
          ntX(p) = (m00*X + m10*Y + d0) / z
          ntY(p) = (m01*X + m11*Y + d1) / z
        next
        gosub object2            REM -- Draw sub object 2
      elsif f=2 or f=4 then      REM -- Face 2/4 => obj 3
        d2 = px(o1(f,2))
        d0=d2*m00+dx : d1=d2*m01+dy : d2=d2*m02+dz
'       --- Project the vertices onto the cube face
        for p=1 to 8
          Z = itX3(p) * 0.76923
          Y = itY3(p) * 0.76923
          z      = (d2 + m12*Y + m22*Z) / mult
          ntX(p) = (d0 + m10*Y + m20*Z) / z
          ntY(p) = (d1 + m11*Y + m21*Z) / z
        next
        gosub object3            REM -- Draw sub object 3
      else                       REM -- Face 3/5 => obj 1
        d2 = py(o1(f,3))
        d0=d2*m10+dx : d1=d2*m11+dy : d2=d2*m12+dz
'       --- Project the vertices onto the cube face
        for p=1 to 8
          X = itX(p) * 0.47619
          Z = itY(p) * 0.47619
          z      = (m02*X + d2 + m22*Z) / mult
          ntX(p) = (m00*X + d0 + m20*Z) / z
          ntY(p) = (m01*X + d1 + m21*Z) / z
        next
        gosub cube               REM -- Draw sub object 1
      fi
    fi
  fi
next

if in=0 goto loop REM ====================================

'--- Intro foreground stuff (intro is ON as long as in<>0)
if in<4 then
  if in=1 then
    y = prm
    introX = min( 84, introX+0.51)
    prm = prm+1
    if prm=-154 then prm=0 : in=2 fi
  else
    setrgb 1,255,255,255
    if scry>-400 text 1450+scry*5,250,"The real part starts in a few seconds..."
    y = ddy-154
  fi
  setrgb 1,30,30,50
  fill rect -320,-256 to y,256
  clear fill rect y-4,-256 to y,256
  setrgb 1,200,200,255
  line y-3,-256 to y-3,256
  if in<>1 then
    clear fill rect -300,scry+319 to -180,scry+344
    text -310,scry+750,S$,"lb"
    if scry<-974 then
      if in=2 then in=3 : iz=dz fi
      ddy = ddy-2
      introX=max(0,introX-1.5)
      if y<-320 then  in=4 : prm=0 : S$=""  fi
    elsif scry<-880 then
      introX = introX-0.7
    else
      rect -300,scry+319 to -180,scry+344
      x=-213 : y=scry+556 : gosub iconTriangle
      x=-307 : y=y+17     : gosub iconSquare
    fi
    scry = scry-1
  fi
elsif in<7 then
  y = 260
  if in=6 y=y+450-450*prm
  setrgb 1,0,0,0
  for i=1 to 11
    lineNb = pbl(i,1)
    z = 2 * letter(lineNb,0) + 2
    new curve
    for f=1 to z step 2
      line to letter(lineNb,f+1)-220, y+letter(lineNb,f)
    next
    new curve
    for f=1 to z step 2
      line to 220-letter(lineNb,f+1),-y-letter(lineNb,f)
    next
    y = y-pbl(i,2)
  next
fi

GOTO loop REM ============================================

LABEL cube REM ===========================================
'
' Draws the (cube) sub object #1 (6 faces, 8 vertices).

  for F=1 to 6
    if itP(F)<0 then
      f1=o1(F,1) : f2=o1(F,2) : f3=o1(F,3) : f4=o1(F,4)
      x1=ntX(f1) : y1=ntY(f1)
      x2=ntX(f2) : y2=ntY(f2)
      x3=ntX(f3) : y3=ntY(f3)
      x4=ntX(f4) : y4=ntY(f4)
      c = f+1
      if mode=1 then
'       --- Gouraud shading
        z1=itZ1(f1): z2=itZ1(f2): z3=itZ1(f3): z4=itZ1(f4)
        cr=R(c) : cg=G(c) : cb=B(c)
        setrgb 1, z1*cr, z1*cg, z1*cb
        setrgb 2, z2*cr, z2*cg, z2*cb
        setrgb 3, z3*cr, z3*cg, z3*cb
        gtriangle x1,y1 to x2,y2 to x3,y3
        setrgb 2, z4*cr, z4*cg, z4*cb
        gtriangle x1,y1 to x4,y4 to x3,y3
      else
'       --- Flat shading
        z1=( itZ1(f1)+itZ1(f2)+itZ1(f3)+itZ1(f4) ) / 4
        setrgb 1, z1*R(c), z1*G(c), z1*B(c)
        fill triangle x1,y1 to x2,y2 to x3,y3
        fill triangle x1,y1 to x4,y4 to x3,y3
      fi
'     --- Cel shading
      if cel=1 then
        setrgb 1,0,0,0
        new curve     : line to x1,y1
        line to x2,y2 : line to x3,y3
        line to x4,y4 : line to x1,y1
      fi
    fi
  next

RETURN

LABEL object2 REM ========================================
'
' Draws the sub object #2 (8 faces, 6 vertices).

  for F=1 to 8
    if itP2(F)<0 then
      f1=o2(F,1) : f2=o2(F,2) : f3=o2(F,3)
      x1=ntX(f1) : y1=ntY(f1)
      x2=ntX(f2) : y2=ntY(f2)
      x3=ntX(f3) : y3=ntY(f3)
      c = f+1
      if mode=1 then
'       --- Gouraud shading
        z1=itZ2(f1): z2=itZ2(f2): z3=itZ2(f3)
        cr=R(c) : cg=G(c) : cb=B(c)
        setrgb 1, z1*cr, z1*cg, z1*cb
        setrgb 2, z2*cr, z2*cg, z2*cb
        setrgb 3, z3*cr, z3*cg, z3*cb
        gtriangle x1,y1 to x2,y2 to x3,y3
      else
'       --- Flat shading
        z1=( itZ2(f1)+itZ2(f2)+itZ2(f3) ) / 3
        setrgb 1, z1*R(c), z1*G(c), z1*B(c)
        fill triangle x1,y1 to x2,y2 to x3,y3
      fi
'     --- Cel shading
      if cel=1 clear triangle x1,y1 to x2,y2 to x3,y3
    fi
  next

RETURN

LABEL object3 REM ========================================
'
' Draws the sub object #3 (12 faces, 8 vertices).

  for F=1 to 12
    if itP3(F)<0 then
      f1=o3(F,1) : f2=o3(F,2) : f3=o3(F,3)
      x1=ntX(f1) : y1=ntY(f1)
      x2=ntX(f2) : y2=ntY(f2)
      x3=ntX(f3) : y3=ntY(f3)
      c = f+1
      if mode=1 then
'       --- Gouraud shading
        z1=itZ3(f1): z2=itZ3(f2): z3=itZ3(f3)
        cr=R(c) : cg=G(c) : cb=B(c)
        setrgb 1, z1*cr, z1*cg, z1*cb
        setrgb 2, z2*cr, z2*cg, z2*cb
        setrgb 3, z3*cr, z3*cg, z3*cb
        gtriangle x1,y1 to x2,y2 to x3,y3
      else
'       --- Flat shading
        z1=( itZ3(f1)+itZ3(f2)+itZ3(f3) ) / 3
        setrgb 1, z1*R(c), z1*G(c), z1*B(c)
        fill triangle x1,y1 to x2,y2 to x3,y3
      fi
'     --- Cel shading
      if cel=1 clear triangle x1,y1 to x2,y2 to x3,y3
    fi
  next

RETURN

LABEL matrix REM =========================================
'
' This routine builds the transformation matrix:
' rotation_X . rotation_Y . rotation_Z . homothecy_1/4
' The homothecy in here speeds up the projection computing

  m00 = CY*CZ
  m01 = -CY*SZ
  m02 = SY * 0.25
  m10 = CX*SZ + SX*SY*CZ
  m11 = CX*CZ - SX*SY*SZ
  m12 = SX*CY * -0.25
  m20 = SX*SZ - CX*SY*CZ
  m21 = SX*CZ + CX*SY*SZ
  m22 = CX*CY * 0.25

RETURN

LABEL background REM =====================================
'
' This routine clears the background.
' The background color used depends on the current intro
' step (variable "in").

 if in<4 then
  clear window
 else
  if in=5 then
    setrgb 1, col(1,3,1), col(1,3,2), col(1,3,3)
    fill rect -320,-256 to 320,256
  elsif in<7 then
    setrgb 1, prm*col(1,3,1),prm*col(1,3,2),prm*col(1,3,3)
    fill rect -320,-256 to 320,256
    if in=6 then
      prm = prm - 0.016
      if prm<=0 then prm=0 : in=7 fi
    else
      prm = prm + 0.016
      if prm>=1 then iz=0 : in=5 fi
    fi
  else
    clear window
  fi
 fi

RETURN

LABEL handleKey REM ======================================
'
' Checks gamepad keypress, and adjusts the drawing mode.
' The gamepad is inactive until the intro is over.

  if in=0 then
    x=peek("port1")
    if x<>port then
      port=x
      if port=32768 mode=1-mode  REM -- square   (gouraud)
      if port=4096  cel=1-cel    REM -- triangle (cel)
    fi
  fi

RETURN

LABEL preIntro REM =======================================
'
' Some preprocessing for the intro steps...

  if in<5 dy=dy*1.9
  if in=1 then
    dz=max(dz,dz+iz-0.033)
    iz=iz*0.95
  elsif in=3 or in=4 then
    dz=iz
    iz=iz*1.045
    introX=max(0,introX-0.333)
  elsif in<>2 then
    rX=16*90 : rY=0
    if in=5 then
      dz=max( 1, 50+prm)
      prm=prm-dz/35
      if dz=1 then in=6 : prm=1 fi
    elsif in<7 then
      dz=1
    fi
    if in<7 then
      dx=0 : dy=0 : rZ=0
    elsif in=7 then
      in=8
      if ix=0 if abs(dx)<.002 then ix=1 else dx=0: in=7 fi
      if iy=0 if abs(dy)<.002 then iy=1 else dy=0: in=7 fi
      if iz=0 if dz<1.001     then iz=1 else dz=1: in=7 fi
    elsif in>7 then
      setrgb 1,255,255,255
      if in=8 then
        text 400+prm,-230,"Is that all ???"
        prm=prm-4
        if (prm<-1050) then prm=0 : in=9 fi
      elsif in=9 then
        text 320+prm,-230,"Noooooooooooooooooooo !!!"
        prm=prm-10
        if (prm<-870) then prm=0 : in=10 fi
      elsif dz>1.435 then
        in=0
      fi
    fi
  fi

RETURN

LABEL iconSquare REM =====================================
'
' Draws a "square" key logo at (x,y).

  setrgb 1,255,100,255
  rect x,y-2   to x+10,y-11
  rect x+1,y-3 to x+9 ,y-10
RETURN


LABEL iconTriangle REM ===================================
'
' Draws a "triangle" key logo at (x,y).

  setrgb 1,100,200,100
  fill rect x+4, y-10 to x+6, y-13
  fill rect x+2, y-7  to x+4,  y-11
  fill rect x+6, y-7  to x+8,  y-11
  fill rect x,   y-4  to x+2,  y-8
  fill rect x+8, y-4  to x+10, y-8
  fill rect x-1, y-3  to x+11, y-5

RETURN

'#########################################################
'##
'## That's all folks !!!
'##
'#########################################################