DEFINT I
DEFLNG L
DEFSTR S
DEFDBL D
DEFSNG F

DIM SHARED iB8(63): FOR iA = 0 TO 63: READ iB8(iA): NEXT iA
DATA 00,48,12,60,03,51,15,63,32,16,44,28,35,19,47,31
DATA 08,56,04,52,11,59,07,55,40,24,36,20,43,27,39,23
DATA 02,50,14,62,01,49,13,61,34,18,46,30,33,17,45,29
DATA 10,58,06,54,09,57,05,53,42,26,38,22,41,25,37,21

DIM SHARED fCV(7, 2)
FOR iA = 0 TO 7: FOR iB = 0 TO 2: READ fCV(iA, iB): NEXT iB, iA
DATA -1,-1,-1 , 1,-1,-1 , 1,1,-1 , -1,1,-1
DATA -1,-1, 1 , 1,-1, 1 , 1,1, 1 , -1,1, 1

DIM SHARED iWO(5, 3)
FOR iA = 0 TO 5: FOR iB = 0 TO 3: READ iWO(iA, iB): NEXT iB, iA
DATA 0,1,2,3 , 7,6,5,4 , 3,2,6,7 , 0,4,5,1 , 2,1,5,6 , 0,3,7,4

DIM SHARED iBC(5, 2)
FOR iA = 0 TO 5: FOR iB = 0 TO 2: READ iBC(iA, iB): NEXT iB, iA
DATA 255,0,0 , 0,255,0 , 0,0,255 , 255,255,0 , 255,0,255 , 0,255,255

DIM SHARED sPAT(63, 5) AS STRING
FOR i = 0 TO 63
  FOR iC = 0 TO 5
    sPAT(i, iC) = STRING$(32, 0)
  NEXT iC
  iA = 0: iO = 1
  FOR iY = 0 TO 7
    iB = 0: iN = 1
    FOR iX = 0 TO 7
      IF iB8(iA) <= i THEN iB = iB + iN
      iA = iA + 1: iN = iN + iN
    NEXT iX
    FOR iC = 9 TO 14
      sC = ""
      IF (iC AND 1) THEN sC = sC + CHR$(iB) ELSE sC = sC + CHR$(0)
      IF (iC AND 2) THEN sC = sC + CHR$(iB) ELSE sC = sC + CHR$(0)
      IF (iC AND 4) THEN sC = sC + CHR$(iB) ELSE sC = sC + CHR$(0)
      sC = sC + CHR$(255)
      MID$(sPAT(i, iC - 9), iO, 4) = sC
    NEXT iC
    iO = iO + 4
  NEXT iY
NEXT i

dStart = TIMER: fAngX = 0: fAngY = 0: iPage = 0
DIM frx(7), fry(7), frz(7), fpx(7), fpy(7)

CONST fAspect = 480 / 350
SCREEN 9: WINDOW SCREEN (-2 * fAspect, -2)-(2 * fAspect, 2)
PALETTE 8, 0
SCREEN , , iPage, iPage XOR 1

DO
  CLS
  dNow = TIMER
  fAngX = (dNow - dStart) * .5
  fAngY = fAngX * .77

  ' Rotate Vertices
  FOR i = 0 TO 7
    fX = fCV(i, 0): fY = fCV(i, 1): fz = fCV(i, 2)
    ftx = fX * COS(fAngY) + fz * SIN(fAngY)
    ftz = -fX * SIN(fAngY) + fz * COS(fAngY)
    frx(i) = ftx: frz(i) = fY * SIN(fAngX) + ftz * COS(fAngX)
    fry(i) = fY * COS(fAngX) - ftz * SIN(fAngX)
    fFac = 32 / (32 + frz(i))
    fpx(i) = frx(i) * fFac: fpy(i) = fry(i) * fFac
  NEXT i

  ' Z-Sort faces
  DIM iOrd(5): FOR i = 0 TO 5: iOrd(i) = i: NEXT i
  FOR ii = 0 TO 4
    FOR ij = ii + 1 TO 5
      fA = (frz(iWO(iOrd(ii), 0))) + (frz(iWO(iOrd(ii), 1))) + (frz(iWO(iOrd(ii), 2))) + (frz(iWO(iOrd(ii), 3)))
      fB = (frz(iWO(iOrd(ij), 0))) + (frz(iWO(iOrd(ij), 1))) + (frz(iWO(iOrd(ij), 2))) + (frz(iWO(iOrd(ij), 3)))
      IF fA < fB THEN SWAP iOrd(ii), iOrd(ij)
    NEXT ij
  NEXT ii

  ' render
  FOR i = 0 TO 5
    idx = iOrd(i): i0 = iWO(idx, 0): i1 = iWO(idx, 1): i2 = iWO(idx, 2)
   
    'normal calculation
    fux = frx(i1) - frx(i0): fuy = fry(i1) - fry(i0): fuz = frz(i1) - frz(i0)
    fvx = frx(i2) - frx(i0): fvy = fry(i2) - fry(i0): fvz = frz(i2) - frz(i0)
    ffnx = fuy * fvz - fuz * fvy: ffny = fuz * fvx - fux * fvz: ffnz = fux * fvy - fuy * fvx
   
    IF ffnz > 0 THEN
      iIT = INT((ffnz / SQR(ffnx * ffnx + ffny * ffny + ffnz * ffnz)) * 64 + .5)
      IF iIT > 63 THEN iIT = 63

      fx1 = fpx(iWO(idx, 0)): fy1 = fpy(iWO(idx, 0))
      fx2 = fpx(iWO(idx, 1)): fy2 = fpy(iWO(idx, 1))
      fx3 = fpx(iWO(idx, 2)): fy3 = fpy(iWO(idx, 2))
      fx4 = fpx(iWO(idx, 3)): fy4 = fpy(iWO(idx, 3))

      LINE (fx1, fy1)-(fx2, fy2), 15: LINE -(fx3, fy3), 15
      LINE -(fx4, fy4), 15: LINE -(fx1, fy1), 15
     
      'PAINT ((fx1 + fx2 + fx3 + fx4) / 4, (fy1 + fy2 + fy3 + fy4) / 4), idx + 9, 15
      fX = (fx1 + fx2 + fx3 + fx4) / 4: fY = (fy1 + fy2 + fy3 + fy4) / 4
      PAINT (fX, fY), sPAT(iIT, idx), 15
      IF POINT(-2, -2) THEN i = 10

      iC = 0: IF iIT >= 24 THEN iC = idx + 1

      LINE (fx1, fy1)-(fx2, fy2), iC: LINE -(fx3, fy3), iC
      LINE -(fx4, fy4), iC: LINE -(fx1, fy1), iC
    END IF
  NEXT i
 
  IF POINT(-2, -2) = 0 THEN
    iPage = iPage XOR 1: SCREEN , , iPage, iPage XOR 1
    WAIT &H3DA, 8, 8: WAIT &H3DA, 8, 0
  END IF

LOOP UNTIL LEN(INKEY$)