'===========================================================================
' Subject: QBASIC VECTOR BALLS               Date: 07-25-99 (14:37)       
' Author:  Aaron Severn                      Code: QB, QBasic, PDS        
' Origin:  bob_severn@msn.com              Packet: GRAPHICS.ABC
'===========================================================================
' QBasic Vector Balls
' Here is my version of that popular 3D demo program done in QBasic.
' First off, many thanks to Lithium of VLA and Denthor of Asphyxia, without
' their 3D trainers I would never have figured out the math for this.

' This has to be one of the least complicated 3D programs around, and it
' still does just about everything the others do.  I always found it
' annoying trying to understand code in other 3D programs, with dozens of
' formulas and subroutines going off in every direction it was all but
' impossible to follow.  This program, I'm proud to say, contains only five
' formulas for the 3D and the entire code for the 3D rotation and drawing
' can almost all fit in the QBasic editor window.
' The code for this program would be easy to implement in other programs,
' feel free to do so.

' Aaron Severn
' bob_severn@msn.com
' June 18/97

' Controls

' - / +         decrease/increase rotation around the y-axis
' [ / ]         decrease/increase rotation around the x-axis
' Arrow keys    move the object up, down, left, right
' A / Z         move the object closer to or farther away from the screen
' R             Reset
' Esc           quit

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

' The number of points being rotated.  Subtract 1 because all arrays in the
' program have base 0, so we want points 0-7 instead of 1-8.
numPnts = 14 - 1

DIM origPnt(numPnts) AS pnt                     'start location of each point
DIM newPnt(numPnts) AS pnt                      'rotated point
DIM sine!(360)                                  'sine table
DIM cosine!(360)                                'cosine table
DIM scrX(numPnts)                               'x coord on the screen
DIM scrY(numPnts)                               'y coord on the screen
DIM oldX(numPnts)                               'previous x coord
DIM oldY(numPnts)                               'previous y coord
DIM drawOrder(numPnts)                          'order for drawing the balls
DIM pal(255) AS hues                            'holds the palette
DIM vectorBall(121)                             'sprite of vector ball
DIM mask(121)                                   'mask of vector ball

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

' The following reads the data for each point.  It could easily be set up
' to read from a file, I just wanted to keep everything contained in the one
' file for this program.
FOR i = 0 TO numPnts
   READ origPnt(i).x, origPnt(i).y, origPnt(i).z, origPnt(i).p
NEXT
 
PRINT "QBasic Vector Balls"
PRINT "By Aaron Severn"
PRINT : PRINT : PRINT "Controls"
PRINT : PRINT "- / +         decrease/increase rotation around the y-axis"
PRINT "[ / ]         decrease/increase rotation around the x-axis"
PRINT "Arrow keys    move the object up, down, left, right"
PRINT "A / Z         move the object closer to or farther away from the screen"
PRINT "R             Reset"
PRINT "Esc           quit"
PRINT : PRINT "Press a key..."
SLEEP

SCREEN 13
CLS

FOR i = 1 TO 15                                 'set up the palette
   pal(i).red = 0                               'consisting of 15 shades
   pal(i).green = 0                             'of blue
   pal(i).blue = i * 3 + 18
NEXT

setColours pal(), 1, 15

FOR y = 0 TO 14                                 'get the vector ball sprite
   FOR x = 0 TO 14                              'from data
      READ clr
      PSET (x, y), clr
   NEXT x
NEXT y
GET (0, 0)-(14, 14), vectorBall

FOR y = 0 TO 14                                 'create a mask for the vector
   FOR x = 0 TO 14                              'ball sprite, this makes it
      IF POINT(x, y) THEN                       'possible to put sprites on
        PSET (x, y), 0                          'top of other graphics
      ELSE                                      'without erasing what was
        PSET (x, y), 255                        'underneath
      END IF
   NEXT x
NEXT y
GET (0, 0)-(14, 14), mask
PUT (0, 0), mask, XOR

' Initial values for the object.  Theta is the angle between x and z, phi is
' the angle between y and z.  Note that by changing these two angles we can
' rotate a point to anywhere in 3 dimensional space.
thetaRot = 5: phiRot = 5
xCenter = 160: yCenter = 100: zCenter = -256
theta = 0: phi = 0

justStarted = 1
DO
  FOR i = 0 TO numPnts
     ' Save the old values of x and y so we can erase the balls later.
     oldX(i) = scrX(i): oldY(i) = scrY(i)
    
     ' Three formulas to calculate the location of the point on the 3D graph.
     ' Don't ask me to explain the math for this, it would take too long and
     ' I hardly understand it myself.  If you must know, check out the 3D
     ' trainers that I mentioned above, sorry I can't remember where I found
     ' them, but if you look hard enough...
     newPnt(i).x = -origPnt(i).x * sine!(theta) + origPnt(i).y * cosine!(theta)
     newPnt(i).y = -origPnt(i).x * cosine!(theta) * sine!(phi) - origPnt(i).y * sine!(theta) * sine!(phi) - origPnt(i).z * cosine!(phi) + origPnt(i).p
     newPnt(i).z = -origPnt(i).x * cosine!(theta) * cosine!(phi) - origPnt(i).y * sine!(theta) * cosine!(phi) + origPnt(i).z * sine!(phi)

     ' This takes the 3D points and translates them on to the 2D screen.  The
     ' idea is simple enough, divide x and y by z (the bigger z is, the
     ' farther away it is, and the smaller the object should be).
     ' 256 is the persective, changing it gives the object a different look.
     IF (newPnt(i).z + zCenter) <> 0 THEN
       scrX(i) = 256 * (newPnt(i).x / (newPnt(i).z + zCenter)) + xCenter
       scrY(i) = 256 * (newPnt(i).y / (newPnt(i).z + zCenter)) + yCenter
     END IF

     ' Here we decide which points should be in the foreground and which in
     ' the background.  We draw the ones in the background first so the ones
     ' in the foreground can be put on top of them, thus appearing to be in
     ' front. This section of code organizes the points in a list from
     ' farthest away to closest to the viewer.
     IF i = 0 THEN
       drawOrder(0) = i
     ELSE
       FOR j = 0 TO i - 1
          IF newPnt(i).z > newPnt(drawOrder(j)).z THEN
            FOR k = i - 1 TO j STEP -1
               drawOrder(k + 1) = drawOrder(k)
            NEXT k
            drawOrder(j) = i
            EXIT FOR
          END IF
       NEXT j
       IF j = i THEN drawOrder(j) = i
     END IF
  NEXT i
 
  ' Wait for verticle retrace for smoother animation.
  WAIT &H3DA, 8
  ' Erase the old points here.  I use the mask to clear them because colour
  ' 255 hasn't been set and will appear black, this won't work if colour 255
  ' is anything other than black.  The first if statement makes sure that
  ' this code doesn't execute the first time through the loop, because
  ' there's nothing to erase.  The second if takes care of clipping if the
  ' points go off the screen.
  IF justStarted = 0 THEN
    FOR i = 0 TO numPnts
       IF oldX(drawOrder(i)) > 6 AND oldX(drawOrder(i)) < 312 AND oldY(drawOrder(i)) > 6 AND oldY(drawOrder(i)) < 192 THEN
         PUT (oldX(drawOrder(i)) - 7, oldY(drawOrder(i)) - 7), mask, PSET
       END IF
    NEXT
  END IF

  ' This puts the vector balls on the screen in the proper order so that
  ' points in the foreground will be on top of those in the background.
  FOR i = numPnts TO 0 STEP -1
     IF scrX(drawOrder(i)) > 6 AND scrX(drawOrder(i)) < 312 AND scrY(drawOrder(i)) > 6 AND scrY(drawOrder(i)) < 192 THEN
       PUT (scrX(drawOrder(i)) - 7, scrY(drawOrder(i)) - 7), mask, AND
       PUT (scrX(drawOrder(i)) - 7, scrY(drawOrder(i)) - 7), vectorBall, XOR
     END IF
  NEXT
 
  theta = (theta + thetaRot) MOD 360            'increase theta
  phi = (phi + phiRot) MOD 360                  'increase phi
 
  justStarted = 0

  FOR t = 1 TO 5000: NEXT t
  a$ = INKEY$
  a$ = UCASE$(a$)
 
  ' Handle user input here.
  SELECT CASE a$
         CASE "-"
             IF thetaRot > 0 THEN thetaRot = thetaRot - 1
         CASE "="
             thetaRot = thetaRot + 1
         CASE "["
             IF phiRot > 0 THEN phiRot = phiRot - 1
         CASE "]"
             phiRot = phiRot + 1
         CASE CHR$(0) + CHR$(72)
             IF yCenter > 0 THEN yCenter = yCenter - 1
         CASE CHR$(0) + CHR$(80)
             IF yCenter < 200 THEN yCenter = yCenter + 1
         CASE CHR$(0) + CHR$(75)
             IF xCenter > 0 THEN xCenter = xCenter - 1
         CASE CHR$(0) + CHR$(77)
             IF xCenter < 320 THEN xCenter = xCenter + 1
         CASE "Z"
             zCenter = zCenter - 1
         CASE "A"
             zCenter = zCenter + 1
         CASE "R"
             thetaRot = 5: phiRot = 5
             xCenter = 160: yCenter = 100: zCenter = -256
             theta = 0: phi = 0
         CASE CHR$(27)
             SYSTEM
  END SELECT
  
  DO: a$ = INKEY$: LOOP UNTIL a$ = ""
LOOP UNTIL a$ = CHR$(27)

' Data for the points stored (X,Y,Z,p).
DATA 25,25,25,1
DATA 25,25,-25,1
DATA 25,-25,25,1
DATA 25,-25,-25,1
DATA -25,25,25,1
DATA -25,25,-25,1
DATA -25,-25,25,1
DATA -25,-25,-25,1
DATA 85,0,0,1
DATA -85,0,0,1
DATA 0,85,0,1
DATA 0,-85,0,1
DATA 0,0,85,1
DATA 0,0,-85,1

' Data for the vector ball sprite.
DATA  0, 0, 0, 0,10,10, 9, 8, 8, 7, 7, 0, 0, 0, 0
DATA  0, 0,10,10,11,11, 9, 8, 8, 7, 7, 6, 6, 0, 0
DATA  0,10,11,11,13,13,10, 8, 8, 7, 7, 7, 7, 6, 0
DATA  0,10,11,11,13,13,10, 8, 8, 7, 7, 7, 7, 6, 6
DATA 10,11,13,13,15,15,11, 9, 9, 8, 8, 7, 7, 7, 6
DATA 10,11,13,13,15,15,11, 9, 9, 8, 8, 7, 7, 7, 6
DATA 10,13,15,15,15,15,13,11,11, 9, 9, 8, 8, 7, 6
DATA 10,13,15,15,15,15,13,11,11, 9, 9, 8, 8, 7, 6
DATA 10,13,15,15,15,15,13,11,11, 9, 9, 8, 8, 7, 6
DATA 10,11,13,13,15,15,13, 9, 9, 8, 8, 7, 7, 7, 6
DATA 10,11,13,13,15,15,13, 9, 9, 8, 8, 7, 7, 7, 6
DATA  0,10,11,11,13,13,10, 8, 8, 7, 7, 7, 7, 6, 6
DATA  0,10,11,11,13,13,10, 8, 8, 7, 7, 7, 7, 6, 0
DATA  0, 0,10,10,11,11, 9, 8, 8, 7, 7, 6, 6, 0, 0
DATA  0, 0, 0, 0,10,10, 9, 8, 8, 7, 7, 0, 0, 0, 0

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