DEFINT I
DEFSTR S
DEFDBL D
DEFSNG F

DECLARE SUB GenPat (iColor)

REM $DYNAMIC

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 sgPAT(63, 11)

DIM lPal(31), lBuf(9599 + 1)
lPal(1) = &H3F1515: lPal(2) = &H153F15
lPal(3) = &H3F3F15: lPal(4) = &H15153F
lPal(5) = &H3F153F: lPal(6) = &H153F3F
lPal(7) = &H3F3F3F

iAspect = 1: iZoom = 64: iFill = 2: sKey = ""

DO
  'SHELL "cycles auto" 'for dosbox only
  SCREEN 0: WIDTH 80, 25: COLOR 7, 0: CLS
  LOCATE 3, 1
  PRINT " 1 - 320x200x4    (vsync)"
  PRINT " 2 - 640x200x2    (vsync)"
  PRINT " 3 - 320x200x16   (double buffer)"
  PRINT " 4 - 640x200x16   (double buffer)"
  PRINT " 5 - 640x350x16   (double buffer)"
  PRINT " 6 - 640x480x2    (vsync)"
  PRINT " 7 - 640x480x16   (pal hack)"
  PRINT
  PRINT " 0 - quit"
  iMode = 0: iDblBuf = 0: fExt0 = 1: fExt = 1: iPal = 0: iPat = 0
  sAspect(0) = "OFF": sAspect(1) = "1:1"
  sAspect(2) = "4:3": sAspect(3) = "16:9"
  DO
    LOCATE 2, 1: PRINT " x - Aspect ratio (currently " + sAspect(iAspect) + ") "
    IF sKey = "" THEN sKey = INPUT$(1)
    SELECT CASE sKey
    CASE "0", CHR$(27): END
    CASE "x", "X": iAspect = (iAspect + 1) AND 3
    CASE "1": iWid = 320: iHei = 400: iMode = 1
    CASE "2": iWid = 640: iHei = 400: iMode = 2
    CASE "3": iWid = 320: iHei = 400: iMode = 7: iDblBuf = 1
    CASE "4": iWid = 640: iHei = 400: iMode = 8: iDblBuf = 1
    CASE "5": iWid = 640: iHei = 350: iMode = 9: iDblBuf = 1
    CASE "6": iWid = 640: iHei = 480: iMode = 11
    CASE "7": iWid = 640: iHei = 480: iMode = 12: fExt0 = 1 / 1.25: fExt = 3 / 1.25
    END SELECT
    sKey = ""
  LOOP UNTIL iMode

  'SHELL "cycles max" 'for dosbox only
  SCREEN iMode

  IF iMode = 12 THEN
    OUT &H3D4, &HC: OUT &H3D5, &H25:  OUT &H3D4, &HD: OUT &H3D5, &H44
    iColors = 16: iBgC = 7: iPal = 8: GenPat 15
  ELSE
    PSET (0, 0), 255: iColors = POINT(0, 0) + 1
    iBgC = iColors - 1: GenPat iColors
  END IF

  SELECT CASE iAspect
  CASE 0: fAspect = 1
  CASE 1: fAspect = 480 / iHei
  CASE 2: fAspect = 4 / 3
  CASE 3: fAspect = 16 / 9
  END SELECT

  fAngX = 0: fAngY = 0: iPage = 0
  REDIM frx(7), fry(7), frz(7), fpx(7), fpy(7)

  IF iColors >= 16 THEN PALETTE 8, 0
  IF iDblBuf THEN SCREEN , , iPage, iPage XOR 1
  iR = 0: iOldZoom = 0

  DO
    IF iOldZoom <> iZoom THEN
      iOldZoom = iZoom: fZoom = iZoom / 16
      IF iMode = 12 THEN fZoom = fZoom / (2 / 1.25): IF fZoom < 2 THEN fZoom = 2
      WINDOW SCREEN (-fZoom * fAspect * fExt0, -fZoom * fExt0)-(fZoom * fAspect * fExt, fZoom * fExt)
      'PRINT PMAP(0, 2): END
      fMinX = 0: fMaxX = 0: fMinY = 0: fMaxY = 0
    END IF

    fAngX = TIMER * .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
    REDIM 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
        IF iR = 0 THEN
          WAIT &H3DA, 8
          IF iMode = 12 THEN FOR ii = iPal + 1 TO iPal + 7: PALETTE ii, 0: NEXT
        END IF
        IF iR <> 3 THEN
          iR = 3
          IF iMode <> 12 THEN
            IF fMinX = 0 OR iDblBuf <> 0 THEN
              LINE (-64, -64)-(64, 64), iPal, BF
            ELSE
              LINE (fMinX, fMinY)-(fMaxX, fMaxY), 0, BF
            END IF
            fMinX = 0: fMinY = 0: fMaxX = 0: fMaxY = 0
          END IF
        END IF

        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))

        IF iMode <> 12 AND iDblBuf = 0 THEN
          IF fx1 < fMinX THEN fMinX = fx1
          IF fx2 < fMinX THEN fMinX = fx2
          IF fx3 < fMinX THEN fMinX = fx3
          IF fx4 < fMinX THEN fMinX = fx4
          IF fx1 > fMaxX THEN fMaxX = fx1
          IF fx2 > fMaxX THEN fMaxX = fx2
          IF fx3 > fMaxX THEN fMaxX = fx3
          IF fx4 > fMaxX THEN fMaxX = fx4
          IF fy1 < fMinY THEN fMinY = fy1
          IF fy2 < fMinY THEN fMinY = fy2
          IF fy3 < fMinY THEN fMinY = fy3
          IF fy4 < fMinY THEN fMinY = fy4
          IF fy1 > fMaxY THEN fMaxY = fy1
          IF fy2 > fMaxY THEN fMaxY = fy2
          IF fy3 > fMaxY THEN fMaxY = fy3
          IF fy4 > fMaxY THEN fMaxY = fy4
        END IF

        IF iColors = 4 THEN iC = ((idx \ 2) MOD 3) + 1 ELSE iC = idx + 1
        IF iFill THEN
          LINE (fx1, fy1)-(fx2, fy2), iBgC + iPal: LINE -(fx3, fy3), iBgC + iPal
          LINE -(fx4, fy4), iBgC + iPal: LINE -(fx1, fy1), iBgC + iPal
        ELSE
          LINE (fx1, fy1)-(fx2, fy2), iC + iPal: LINE -(fx3, fy3), iC + iPal
          LINE -(fx4, fy4), iC + iPal: LINE -(fx1, fy1), iC + iPal
        END IF

        fX = (fx1 + fx2 + fx3 + fx4) / 4: fY = (fy1 + fy2 + fy3 + fy4) / 4
        IF iFill <> 0 AND iIT > 3 THEN
          IF iFill = 2 THEN PAINT (fX, fY), sgPAT(iIT, idx + iPat), iBgC + iPal
          IF iFill = 1 THEN PAINT (fX, fY), iC + iPal, iBgC + iPal
          'IF POINT(-2, -2) THEN i = 10: iR = 1: PRINT fAngX; iIT: END
        END IF

        IF iFill = 2 THEN
          'IF iIT < 24 THEN iC = iPal 'ELSE iC = iC AND 7
          LINE (fx1, fy1)-(fx2, fy2), iC + iPal: LINE -(fx3, fy3), iC + iPal
          LINE -(fx4, fy4), iC + iPal: LINE -(fx1, fy1), iC + iPal
        END IF
      END IF
    NEXT i

    IF iMode = 12 THEN
      GET (PMAP(0, 2), PMAP(0, 3))-(PMAP(319, 2), PMAP(239, 3)), lBuf
      LINE (PMAP(0, 2), PMAP(0, 3))-(PMAP(319, 2), PMAP(255, 3)), iPal, BF
      WAIT &H3DA, 8: FOR i = 1 TO 7: PALETTE iPal + i, lPal(i): NEXT
      PUT (PMAP(319, 2), PMAP(239, 3)), lBuf, PSET
      iPal = iPal XOR 8: iPat = iPat XOR 6
    END IF

    IF iDblBuf THEN iPage = iPage XOR 1: SCREEN , , iPage, iPage XOR 1
    iR = 0: sKey = INKEY$
    SELECT CASE sKey
    CASE "0" TO "9", CHR$(27), CHR$(13), CHR$(32): iMode = 0
    CASE "+", "=": IF iZoom > 32 THEN iZoom = iZoom - 1
    CASE "-", "_": IF iZoom < 128 THEN iZoom = iZoom + 1
    CASE "f", "F", CHR$(9): iFill = (iFill + 1) MOD 3
    END SELECT

  LOOP WHILE iMode

LOOP

REM $STATIC
DEFSNG D
SUB GenPat (iMaxColors)
  SELECT CASE iMaxColors
  CASE 15, 16
    FOR i = 0 TO 63
      FOR iC = 0 TO 11: sgPAT(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 = 1 TO 6
          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)
          MID$(sgPAT(i, iC - 1), iO, 4) = sC + CHR$(255)
          IF iMaxColors = 15 THEN
            MID$(sgPAT(i, iC + 5), iO, 4) = sC + CHR$(0)
          END IF
        NEXT iC
        iO = iO + 4
      NEXT iY
    NEXT i
  CASE 2
    FOR i = 0 TO 63
      FOR iC = 0 TO 5: sgPAT(i, iC) = STRING$(8, 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 = 1 TO 6
          MID$(sgPAT(i, iC - 1), iO, 1) = CHR$(iB)
        NEXT iC
        iO = iO + 1
      NEXT iY
    NEXT i
  CASE 4
    FOR i = 0 TO 63
      FOR iC = 0 TO 5: sgPAT(i, iC) = STRING$(16, 0): NEXT iC
      iA = 0: iO = 1
      FOR iY = 0 TO 15
        iB = 0
        IF iB8(iA + 0) <= i THEN iB = iB + 1
        IF iB8(iA + 1) <= i THEN iB = iB + 4
        IF iB8(iA + 2) <= i THEN iB = iB + 16
        IF iB8(iA + 3) <= i THEN iB = iB + 64
        iA = iA + 4
        FOR iC = 0 TO 5
          MID$(sgPAT(i, iC), iO, 4) = CHR$(iB * (((iC \ 2) MOD 3) + 1))
        NEXT iC
        iO = iO + 1: iA = iA + 4
        IF iA > 63 THEN iA = iA - 60
      NEXT iY
    NEXT i
  CASE ELSE
    PRINT ("Error"): END
  END SELECT

END SUB