'===========================================================================
' Subject: ROTATING 3D POLYGON ROUTINE       Date: 07-25-99 (11:59)       
' Author:  Aaron Severn                      Code: QB, QBasic, PDS        
' Origin:  bob_severn@msn.com              Packet: GRAPHICS.ABC
'===========================================================================
' 3DPOLY.BAS
' by Aaron Severn
' June 18/97

' This uses the same 3D routines as the vector ball program, but instead of
' rotating points it rotates lines which are connected to form an interresting
' shape.  The idea is simple, each line consists of two points, both points
' are rotated and a line in drawn between them.
' Unlike vector balls, this program is 100% user driven, the object won't
' move without you.  I've also added the ability to move the center of the
' object which gets interresting results.

' I've been trying to figure out how to eliminate the lines of the back of
' the shape so that it is a solid polygon instead of a transparent one like
' it is now.  I believe the technique is called plane elimination.  Anyway,
' so far I haven't gotten it to work, so if anyone knows how could you tell
' me or make the changes and send me the code or whatever.  My e-mail is
' bob_severn@msn.com.  Thanks.

' As I mentioned above, there's a little more motion going on in this program
' than in the other one, thus the controls are kind of complicated.  Here
' they are:

' Left and right arrow keys - rotate around y-axis
'    Up and down arrow keys - rotate around x-axis
'                   A and Z - move view point closer/farther away
'                   X and V - move view point left/right
'                   D and C - move view point up/down
'                   ; and / - move object's center closer/farther away
'                   M and . - move object's center left/right
'                   K and , - move object's center up/down
'                         R - reset
'                       Esc - quit

' The documentation in this program will be much more brief than vector balls.
' If you want more detail on the formulas, check it out.

DEFINT A-Z

DECLARE SUB setColours (pal() AS ANY, fc, lc)

TYPE pnt                                        'type for each 3D point
    x AS INTEGER                                'x coord (horizontal)
    y AS INTEGER                                'y coord (vertical)
    Z AS INTEGER                                'z coord (into the screen)
    p AS INTEGER                                'dist from center of object
END TYPE

TYPE hues                                       'type for palette
    red AS INTEGER
    green AS INTEGER
    blue AS INTEGER
END TYPE

numLines = 24 - 1

DIM origLine(numLines, 1) AS pnt
DIM newLine(numLines, 1) AS pnt
DIM scrX(numLines, 1)
DIM scrY(numLines, 1)
DIM oldX(numLines, 1)
DIM oldY(numLines, 1)
DIM sine!(360)
DIM cosine!(360)

CONST PI = 3.14159

FOR i = 0 TO 360                                'create sine and cosine
   sine!(i) = SIN(i * (PI / 180))               'look up tables to speed up
   cosine!(i) = COS(i * (PI / 180))             'the math
NEXT

' Read two points instead of one.
FOR i = 0 TO numLines
   READ origLine(i, 0).x, origLine(i, 0).y, origLine(i, 0).Z, origLine(i, 0).p
   READ origLine(i, 1).x, origLine(i, 1).y, origLine(i, 1).Z, origLine(i, 1).p
NEXT

PRINT "3DPOLY.BAS"
PRINT "By Aaron Severn"
PRINT : PRINT : PRINT "Controls"
PRINT : PRINT "Left and right arrow keys - rotate around y-axis"
PRINT "Up and down arrow keys - rotate around x-axis"
PRINT "               A and Z - move view point closer/farther away"
PRINT "               X and V - move view point left/right"
PRINT "               D and C - move view point up/down"
PRINT "               ; and / - move object's center closer/farther away"
PRINT "               M and . - move object's center left/right"
PRINT "               K and , - move object's center up/down"
PRINT "                     R - reset"
PRINT "                   Esc - quit"
PRINT : PRINT "Press a key..."
SLEEP

SCREEN 13
CLS

xCenter = 160: yCenter = 100: zCenter = 250
theta = 0: phi = 0

justStarted = 1
DO
  FOR i = 0 TO numLines
     ' Save the old values of x and y so we can erase the balls later.
     oldX(i, 0) = scrX(i, 0): oldY(i, 0) = scrY(i, 0)
     oldX(i, 1) = scrX(i, 1): oldY(i, 1) = scrY(i, 1)
    
     ' Rotate both points on each axis.
     newLine(i, 0).x = -origLine(i, 0).x * sine!(theta) + origLine(i, 0).y * cosine!(theta)
     newLine(i, 0).y = -origLine(i, 0).x * cosine!(theta) * sine!(phi) - origLine(i, 0).y * sine!(theta) * sine!(phi) - origLine(i, 0).Z * cosine!(phi) + origLine(i, 0).p
     newLine(i, 0).Z = -origLine(i, 0).x * cosine!(theta) * cosine!(phi) - origLine(i, 0).y * sine!(theta) * cosine!(phi) + origLine(i, 0).Z * sine!(phi)

     newLine(i, 1).x = -origLine(i, 1).x * sine!(theta) + origLine(i, 1).y * cosine!(theta)
     newLine(i, 1).y = -origLine(i, 1).x * cosine!(theta) * sine!(phi) - origLine(i, 1).y * sine!(theta) * sine!(phi) - origLine(i, 1).Z * cosine!(phi) + origLine(i, 1).p
     newLine(i, 1).Z = -origLine(i, 1).x * cosine!(theta) * cosine!(phi) - origLine(i, 1).y * sine!(theta) * cosine!(phi) + origLine(i, 1).Z * sine!(phi)

     ' Translate both points from 3D to 2D.
     IF (newLine(i, 0).Z + zCenter) <> 0 THEN
       scrX(i, 0) = 256 * (newLine(i, 0).x / (newLine(i, 0).Z + zCenter)) + xCenter
       scrY(i, 0) = 256 * (newLine(i, 0).y / (newLine(i, 0).Z + zCenter)) + yCenter
     END IF

     IF (newLine(i, 1).Z + zCenter) <> 0 THEN
       scrX(i, 1) = 256 * (newLine(i, 1).x / (newLine(i, 1).Z + zCenter)) + xCenter
       scrY(i, 1) = 256 * (newLine(i, 1).y / (newLine(i, 1).Z + zCenter)) + yCenter
     END IF
  NEXT i

  ' Erase the old lines.
  WAIT &H3DA, 8
  IF justStarted = 0 THEN
    FOR i = 0 TO numLines
       LINE (oldX(i, 0), oldY(i, 0))-(oldX(i, 1), oldY(i, 1)), 0
    NEXT i
  END IF

  ' Draw the new lines.  Note: no clipping yet.
  FOR i = 0 TO numLines
     LINE (scrX(i, 0), scrY(i, 0))-(scrX(i, 1), scrY(i, 1)), 11
  NEXT i
 
  justStarted = 0
  A$ = INKEY$
  A$ = UCASE$(A$)
  SELECT CASE A$
         CASE "A"
             zCenter = zCenter - 2
         CASE "Z"
             zCenter = zCenter + 2
         CASE "X"
             xCenter = xCenter + 2
         CASE "V"
             xCenter = xCenter - 2
         CASE "C"
             yCenter = yCenter - 2
         CASE "D"
             yCenter = yCenter + 2
         CASE "K"
             FOR i = 0 TO numLines
                origLine(i, 0).Z = origLine(i, 0).Z + 2
                origLine(i, 1).Z = origLine(i, 1).Z + 2
             NEXT
         CASE ","
             FOR i = 0 TO numLines
                origLine(i, 0).Z = origLine(i, 0).Z - 2
                origLine(i, 1).Z = origLine(i, 1).Z - 2
             NEXT
         CASE ";"
             FOR i = 0 TO numLines
                origLine(i, 0).x = origLine(i, 0).x + 2
                origLine(i, 1).x = origLine(i, 1).x + 2
             NEXT
         CASE "/"
             FOR i = 0 TO numLines
                origLine(i, 0).x = origLine(i, 0).x - 2
                origLine(i, 1).x = origLine(i, 1).x - 2
             NEXT
         CASE "."
             FOR i = 0 TO numLines
                origLine(i, 0).y = origLine(i, 0).y + 2
                origLine(i, 1).y = origLine(i, 1).y + 2
             NEXT
         CASE "M"
             FOR i = 0 TO numLines
                origLine(i, 0).y = origLine(i, 0).y - 2
                origLine(i, 1).y = origLine(i, 1).y - 2
             NEXT
         CASE CHR$(0) + CHR$(75)
             theta = theta - 5
             IF theta < 0 THEN theta = theta + 360
         CASE CHR$(0) + CHR$(77)
             theta = (theta + 5) MOD 360
         CASE CHR$(0) + CHR$(72)
             phi = (phi + 5) MOD 360
         CASE CHR$(0) + CHR$(80)
             phi = phi - 5
             IF phi < 0 THEN phi = phi + 360
         CASE "R"
             RESTORE
             FOR i = 0 TO numLines
                READ origLine(i, 0).x, origLine(i, 0).y, origLine(i, 0).Z, origLine(i, 0).p
                READ origLine(i, 1).x, origLine(i, 1).y, origLine(i, 1).Z, origLine(i, 1).p
             NEXT
             xCenter = 160: yCenter = 100: zCenter = 250
             theta = 0: phi = 0
             justStarted = 1
             CLS
         CASE CHR$(27)
             SYSTEM
  END SELECT
  DO: A$ = INKEY$: LOOP UNTIL A$ = ""
LOOP UNTIL A$ = CHR$(27)

' Lines are stored in format (X1,Y1,Z1,p1)-(X2,Y2,Z2,p2)
DATA -20,20,20,1,-60,0,0,1
DATA -20,-20,20,1,-60,0,0,1
DATA -20,20,-20,1,-60,0,0,1
DATA -20,-20,-20,1,-60,0,0,1
DATA 20,20,20,1,60,0,0,1
DATA 20,-20,20,1,60,0,0,1
DATA 20,20,-20,1,60,0,0,1
DATA 20,-20,-20,1,60,0,0,1
DATA 20,-20,20,1,0,-60,0,1
DATA -20,-20,20,1,0,-60,0,1
DATA 20,-20,-20,1,0,-60,0,1
DATA -20,-20,-20,1,0,-60,0,1
DATA 20,20,20,1,0,60,0,1
DATA -20,20,20,1,0,60,0,1
DATA 20,20,-20,1,0,60,0,1
DATA -20,20,-20,1,0,60,0,1
DATA 20,20,-20,1,0,0,-60,1
DATA -20,20,-20,1,0,0,-60,1
DATA 20,-20,-20,1,0,0,-60,1
DATA -20,-20,-20,1,0,0,-60,1
DATA 20,20,20,1,0,0,60,1
DATA -20,20,20,1,0,0,60,1
DATA 20,-20,20,1,0,0,60,1
DATA -20,-20,20,1,0,0,60,1

SUB setColours (pal() AS hues, fc, lc)

OUT &H3C8, fc                                   'tell controller to get ready
FOR t = fc TO lc                                'from first to last
   OUT &H3C9, pal(t).red                        'send red component
   OUT &H3C9, pal(t).green                      'send green component
   OUT &H3C9, pal(t).blue                       'send blue component
NEXT t

END SUB