'===========================================================================
' Subject: ROTATING TRIANGLES                Date: 04-10-97 (19:22)       
' Author:  The ABC Programmer                Code: QB, QBasic, PDS        
' Origin:  Convert from Pascal Code        Packet: GRAPHICS.ABC
'===========================================================================
' Fractal 3D - Rotating Triangles
'
'   Programmed by Ryan Jones (Dios@Rworld.Com)
' Converted to BASIC by William Yu (04-10-97)

DECLARE SUB Rotate (X!, Y!, ang!)
DECLARE SUB RotateTris (ang!)
DECLARE SUB RotateTrisb (ang!)
DECLARE SUB RotateTrisc (ang!)
DECLARE SUB ClipLine (X1%, Y1%, X2%, Y2%, C%)
DECLARE SUB AddTris (n%)
DECLARE SUB DrawTris ()
DEFINT A-Z

CONST ZInc = 25
CONST ZOfs = 256
CONST ZScale = 256
CONST Sc = .7
CONST Pi = 3.141593

TYPE Triangle
   X1 AS SINGLE
   Y1 AS SINGLE
   Z1 AS SINGLE
   X2 AS SINGLE
   Y2 AS SINGLE
   Z2 AS SINGLE
   X3 AS SINGLE
   Y3 AS SINGLE
   Z3 AS SINGLE
END TYPE

DIM SHARED Tris(0 TO 100) AS Triangle
DIM SHARED Trin, l, n, hn

SCREEN 7, 0, 0, 0

  Tris(0).X1 = 0
  Tris(0).Y1 = 86
  Tris(0).Z1 = 0
  Tris(0).X2 = 100
  Tris(0).Y2 = -86
  Tris(0).Z2 = 0
  Tris(0).X3 = -100
  Tris(0).Y3 = -86
  Tris(0).Z3 = 0
  Tris(0).X1 = Tris(0).X1 * Sc
  Tris(0).Y1 = Tris(0).Y1 * Sc
  Tris(0).Z1 = Tris(0).Z1 * Sc
  Tris(0).X2 = Tris(0).X2 * Sc
  Tris(0).Y2 = Tris(0).Y2 * Sc
  Tris(0).Z2 = Tris(0).Z2 * Sc
  Tris(0).X3 = Tris(0).X3 * Sc
  Tris(0).Y3 = Tris(0).Y3 * Sc
  Tris(0).Z3 = Tris(0).Z3 * Sc

   Trin = 1
   l = 3
   DO
        n = hn
        hn = Trin
        DO
             CALL AddTris(n)
             n = n + 1
        LOOP UNTIL n = hn
        l = l - 1
   LOOP UNTIL l = 0

   DO
        n = 0
        DO
             DrawTris
             CALL RotateTris(Pi / 72)
             n = n + 1
        LOOP UNTIL INKEY$ <> "" OR (n = 144)
        n = 0
        DO
             DrawTris
             CALL RotateTrisb(Pi / 72)
             n = n + 1
        LOOP UNTIL INKEY$ <> "" OR (n = 144)
        n = 0
        DO
             DrawTris
             CALL RotateTrisc(Pi / 72)
             n = n + 1
        LOOP UNTIL INKEY$ <> "" OR (n = 144)
   LOOP UNTIL INKEY$ <> ""
  
END

SUB AddTris (n)
  DIM OX1 AS SINGLE
  DIM OY1 AS SINGLE
  DIM OZ1 AS SINGLE
  DIM OX2 AS SINGLE
  DIM OY2 AS SINGLE
  DIM OZ2 AS SINGLE
  DIM OX3 AS SINGLE
  DIM OY3 AS SINGLE
  DIM OZ3 AS SINGLE

                 OX1 = Tris(n).X1
                 OY1 = Tris(n).Y1
                 OZ1 = Tris(n).Z1
                 OX2 = Tris(n).X2
                 OY2 = Tris(n).Y2
                 OZ2 = Tris(n).Z2
                 OX3 = Tris(n).X3
                 OY3 = Tris(n).Y3
                 OZ3 = Tris(n).Z3
            Tris(Trin).X1 = OX1
            Tris(Trin).Y1 = OY1
            Tris(Trin).Z1 = OZ1 + ZInc
            Tris(Trin).X2 = OX1 * 2 / 3 + OX2 / 3
            Tris(Trin).Y2 = OY1 * 2 / 3 + OY2 / 3
            Tris(Trin).Z2 = OZ2 + ZInc
            Tris(Trin).X3 = OX1 * 2 / 3 + OX3 / 3
            Tris(Trin).Y3 = OY1 * 2 / 3 + OY3 / 3
            Tris(Trin).Z3 = OZ3 + ZInc
                 Tris(Trin + 1).X1 = OX2 * 2 / 3 + OX1 / 3
                 Tris(Trin + 1).Y1 = OY2 * 2 / 3 + OY1 / 3
                 Tris(Trin + 1).Z1 = OZ1 + ZInc
                 Tris(Trin + 1).X2 = OX2
                 Tris(Trin + 1).Y2 = OY2
                 Tris(Trin + 1).Z2 = OZ2 + ZInc
                 Tris(Trin + 1).X3 = OX2 * 2 / 3 + OX3 / 3
                 Tris(Trin + 1).Y3 = OY2 * 2 / 3 + OY3 / 3
                 Tris(Trin + 1).Z3 = OZ3 + ZInc
                 Tris(Trin + 2).X1 = OX3 * 2 / 3 + OX1 / 3
                 Tris(Trin + 2).Y1 = OY3 * 2 / 3 + OY1 / 3
                 Tris(Trin + 2).Z1 = OZ1 + ZInc
                 Tris(Trin + 2).X2 = OX3 * 2 / 3 + OX2 / 3
                 Tris(Trin + 2).Y2 = OY3 * 2 / 3 + OY2 / 3
                 Tris(Trin + 2).Z2 = OZ2 + ZInc
                 Tris(Trin + 2).X3 = OX3
                 Tris(Trin + 2).Y3 = OY3
                 Tris(Trin + 2).Z3 = OZ3 + ZInc
      Trin = Trin + 3
END SUB

SUB ClipLine (X1, Y1, X2, Y2, C)
  IF (X1 > 0) AND (X1 < 320) AND (Y1 > 0) AND (Y1 < 200) AND (X2 > 0) AND (X2 < 320) AND (Y2 > 0) AND (Y2 < 200) THEN
    LINE (X1, Y1)-(X2, Y2), C
  END IF
END SUB

SUB DrawTris
      n = 0
      ' Uncomment the two lines below for flicker free rotation
      'PCOPY 0, 1
      'SCREEN 7, 0, 0, 1
      LINE (0, 0)-(319, 199), 0, BF
      DO
         SX1 = INT((ZScale * Tris(n).X1) / (Tris(n).Z1 - ZOfs))
         SY1 = INT((ZScale * Tris(n).Y1) / (Tris(n).Z1 - ZOfs))
         SX2 = INT((ZScale * Tris(n).X2) / (Tris(n).Z2 - ZOfs))
         SY2 = INT((ZScale * Tris(n).Y2) / (Tris(n).Z2 - ZOfs))
         SX3 = INT((ZScale * Tris(n).X3) / (Tris(n).Z3 - ZOfs))
         SY3 = INT((ZScale * Tris(n).Y3) / (Tris(n).Z3 - ZOfs))
         'CALL ClipLine(160 + SX1, 100 + SY1, 160 + SX2, 100 + SY2, 8)
         'CALL ClipLine(160 + SX2, 100 + SY2, 160 + SX3, 100 + SY3, 15)
         'CALL ClipLine(160 + SX3, 100 + SY3, 160 + SX1, 100 + SY1, 7)
         LINE (160 + SX1, 100 + SY1)-(160 + SX2, 100 + SY2), 8
         LINE (160 + SX2, 100 + SY2)-(160 + SX3, 100 + SY3), 15
         LINE (160 + SX3, 100 + SY3)-(160 + SX1, 100 + SY1), 7
         n = n + 1
      LOOP UNTIL n = Trin
END SUB

SUB Rotate (X!, Y!, ang!)
  DIM XX AS SINGLE
  DIM YY AS SINGLE

  XX = X! * COS(ang!) + Y! * SIN(ang!)
  YY = Y! * COS(ang!) - X! * SIN(ang!)
  X! = XX
  Y! = YY
END SUB

SUB RotateTris (ang!)
      n = 0
      DO
              CALL Rotate(Tris(n).X1, Tris(n).Z1, ang!)
              CALL Rotate(Tris(n).X2, Tris(n).Z2, ang!)
              CALL Rotate(Tris(n).X3, Tris(n).Z3, ang!)
              n = n + 1
      LOOP UNTIL n = Trin
END SUB

SUB RotateTrisb (ang!)
      n = 0
      DO
              CALL Rotate(Tris(n).X1, Tris(n).Y1, ang!)
              CALL Rotate(Tris(n).X2, Tris(n).Y2, ang!)
              CALL Rotate(Tris(n).X3, Tris(n).Y3, ang!)
              n = n + 1
      LOOP UNTIL n = Trin
END SUB

SUB RotateTrisc (ang!)
      n = 0
      DO
              CALL Rotate(Tris(n).Y1, Tris(n).Z1, ang!)
              CALL Rotate(Tris(n).Y2, Tris(n).Z2, ang!)
              CALL Rotate(Tris(n).Y3, Tris(n).Z3, ang!)
              n = n + 1
      LOOP UNTIL n = Trin
END SUB