'===========================================================================
' Subject: ROTATING 3D POLYGON               Date: 11-17-97 (20:11)       
' Author:  William T. Jones                  Code: QB, QBasic, PDS        
' Origin:  wtjones@tcac.net                Packet: GRAPHICS.ABC
'===========================================================================
'                 ********** Polygon 3D dev 3.1 **********
'
'                             November 1997
'                                   by
'                    William Jones  wtjones@tcac.net
'
'---------- Overview --------                    
'  Basically a cube you control with the keyboard. Press "f" for filled
'mode.
'  There are countless numbers of this tired type of demo, but I am in the
'learning process and it is my duty to make one. This may not be original,
'but I bet this is THE MOST THOROUGH 3D cube progam ever made
'for QBASIC. Scroll down a couple of pages to see the controls.

'---------- The story thus far... ------------
'  This demonstration is loosely based on the "VGA Trainer Program 8"
'by Denthor of Asphixia. I first ported the C version of his trainer to
'QBASIC, then wrote this.
'  In order for a program to be a tourial, it must be very readable and easy
'to understand. Because of that, his version is not optimized for speed.
'  The basic elemet was a line, which means the starting 3D point and the
'ending 3D point. There were of course 12 lines to make a Wireframe cube.
'That's 24 points to manipulated each frame of animation, 3 times as many as
'a cube has. While messing around, I connected lines in through the center.
'The more lines to be rendered, the slower it got.
'  I then re-wrote it so the basic element is a point. In the case of a cube
'there are 8 points. That is all that needs to be calculated. Each point is
'perspective projected into 2D screen coordinates and stored in an integer
'array. Then the points can be used for polygons.
'  Here's how the points are indexed:
'
'     1- - - - -  2
'    /|          /|
' 5/ -|- - - -6/  |
' |   |       |   |
' |   |       |   |
' |   3- - - -| - 4
' |  /        |  /
' 7/ - - - - -8/
'
'1 through 4 in the back, 5 through 8 in the front.
'
'  The polygon() array contains the indices of the four points that make up
'each polygon (for use in the cubePoint() array). There is of course one for
'each side of the cube. Having the polygon structure address already made
'point's instead of having it's own is probably against good practice, but
'I don't see the need to keep rendering points that in the same exact spot.
'You will notice that the only data types are for points. That is because
'QBASIC doesn't allow structures to have arrays. If I move this to C it will
'look completely different (and easier to read).
'If someone has a better way that I should be doing things and you have the
'time, please email me at wtjones@tcac.net and explain.
'  Each polygon is
'drawn by connecting its points. The first polygon (array element 1,X) is
'the top of the cube. Its points are 1, 2, 6 and 5. They are in that order
'(clockwise) so that when the normal is found, the outer direction is drawn
'when visible. (It doesn't make much sense to me either)
'
'---------- Controls ----------
'  -num lock must be on
'  -on numerical keypad
'     -"8" and "2" rotate on the x axis
'     -"4" and "6" rotate on the y axis
'     -"7" and "9" rotate on the z axis
'     -"5" stops all motion
'     -"0" resets values
'     -"+" and "-" move along the z perspective
'  -arrow keys change x and y values
'  -"p" toggles printing variables to screen
'  -"h" toggles hidden surface removal
'  -"f" toggles filled polygon mode
'
'---------- Features ----------
'  -Decent speed for QBASIC.
'  -Many aspects can be controlled with keyboard.
'  -Set 'VariableOutput' to 'true' (or press "p") to print the angle and
'     velocity of each axis.
'
'---------- Errata ----------
'  -I want to implement a freely movable 'camera'. That way I can set up a 3d
'   world and use the keyboard to wander around it. It seems the way to do it
'   would be to tranlate all objects using a constant factor when a certan
'   key is pressed, sort of like it is now but instead not having the
'   perspective fixed.
'  -Also planned is matrix mathmatics. Almost all references to 3D
'   programming have matrix content so it seems standard. It's best I learn
'   too.
'  -If you give points decimal values, 'CubePoints()' must be declared of
'   type 'Point3d' instead of 'Point3dInt'. (another picky optimization)
'
'---------- Updates ----------
'  Febuary 1997
'     -Finished dev 2
'  April 19, 1997
'     -Cleaned code/typos and such. Now called dev 2.1.
'  November 14, 1997
'     -The line-connecting system is gone. Four points can be declared as
'        a polygon to be drawn (conneced with lines).
'     -Hidden surface removal is added. Only visible polygon surfaces will be
'        drawn/outlined. Press "h" to turn it off.
'     -When moving the cube with the arrow keys and plus and minus, the cube
'        doesn't rotate around the same axis like before. The points are
'        first rotated and then added to a base to fix this. xLoc, yLoc, zLoc
'        is the base. If anybody knows why it moves so jumpy please tell me.
'     -Program is now 3.0
'  November 17, 1997
'     -Added filled polygon mode. Press "f" to use. I might put in a fill
'        routine, but for now the PAINT statement goes outside the lines.
'        I don't know how to fix it, but it's annoying.
'     -The frame rate is now printed at the bottom of the screen, but the
'        numbers don't seem right. When I turn on fill mode it feels
'        sluggish, but I still get an FPS of 90 or more.
'     -Program is now 3.1 (who cares?)
'
'|---------- CONSTANTS ------------------------|
CONST pi = 3.141592     'single precision for speed
CONST true = -1, false = 0
CONST NumPoints = 8     'the original 8 make a cube, you can easily add more
CONST NumPolygons = 6   '6 faces of a cube
CONST XOff = 160        'VGA sceen offsets for projection
CONST YOff = 100
CONST ZOff = -60

CONST HScale = 256      'change these to make it look really weird
CONST VScale = 256
CONST OutlineColor = 15
'|---------- DATA TYPES -----------------------|
TYPE Point2DType         'VGA screen coordinates
   x AS INTEGER
   y AS INTEGER
END TYPE
TYPE Point3dType         'floating point values for translation equations
   x AS SINGLE
   y AS SINGLE
   z AS SINGLE
END TYPE
TYPE Point3dIntType  'used for 3d offsets from DATA if they are whole numbers
   x AS INTEGER
   y AS INTEGER
   z AS INTEGER
END TYPE

'|---------- VARIABLE/ARRAY  DECLARATIONS -----|
DIM n AS INTEGER, m AS INTEGER      'looping indices

DIM polygons(1 TO NumPolygons, 1 TO 4) AS Point2DType    'point references
DIM visiblePolys(1 TO NumPolygons) AS INTEGER   'true or false
DIM cubePoint(1 TO NumPoints) AS Point3dIntType  'loaded from DATA
DIM cubeVidPoint(1 TO NumPoints) AS Point2DType  'projected  2D points
DIM ccos(0 TO 359) AS SINGLE, csin(0 TO 359) AS SINGLE
DIM trans(1 TO NumPoints) AS Point3dType   'final translated points
DIM boxErase(1 TO 2) AS Point2DType  'holds the immediate box around the cube
DIM xDeg AS INTEGER, yDeg AS INTEGER, zDeg AS INTEGER    'axis degrees
DIM xRate AS INTEGER, yRate AS INTEGER, zRate AS INTEGER 'axis velocities
DIM xLoc AS INTEGER, yLoc AS INTEGER, zLoc AS INTEGER

'-temps
DIM midPoint AS Point2DType   'for finding mid-points of polygons
DIM temp AS Point3dType  'temporary buffer for translation
DIM timeTemp AS SINGLE
DIM nextSec AS SINGLE

'-boolean flags-
DIM done AS INTEGER                 'boolean for escape key
DIM variableOutput AS INTEGER       'boolean to print angle/velocity
DIM wireFrame AS INTEGER            'false for just dots
DIM hsr AS INTEGER               'hidden surface removal
DIM filled AS INTEGER

'|---------- SETUP ----------------------------|
DEFINT A-Z  'all variables integers by default
  'load nessesary values of sine and cosine into lookup tables
PRINT "Creating tables..."
FOR n = 0 TO 359
  ccos(n) = COS(n * pi / 180)
  csin(n) = SIN(n * pi / 180)
NEXT n
   'read in point offsets from data
RESTORE CubeData
FOR n = 1 TO NumPoints
   READ cubePoint(n).x
   READ cubePoint(n).y
   READ cubePoint(n).z
NEXT
   'read in the indices of the 4 points each polygon consists of
RESTORE PolygonData
FOR n = 1 TO NumPolygons
   FOR m = 1 TO 4
      READ polygon(n, m)
   NEXT
NEXT

xDeg = 0: yDeg = 0: zDeg = 0     'degrees to refrence sin/cos tables,
                                 'each will only be in range of 0-359

xRate = 0: yRate = 0: zRate = 0  'degree incements
variableOutput = false
wireFrame = false
hsr = true  'hidden surface removal on
filled = false

'|---------------------------------------------|
'|---------- MAIN PROGRAM ---------------------|
'|---------------------------------------------|

SCREEN 7, , 1, 0        'page 0 is visual, page 1 active
timeTemp = INT(TIMER): nextSec = timeTemp + 1
DO
   GOSUB RotatePoints
   GOSUB ProjectPoints  'produce 2D coordinates ready for drawing
   GOSUB FindVisibleSides
  
   '-do all drawing-
   IF variableOutput = true THEN GOSUB PrintOut 'angle/velocity                                                                                  '''''
  
   '-draw the visible sides of the polygon-
   FOR n = 1 TO 6
    IF visiblePolys(n) = true THEN GOSUB OutlinePolygon
   NEXT
   IF filled = true THEN GOSUB FillPolygons
  
   PCOPY 1, 0           'copy active page to visual
   GOSUB UpdateFrameRate
  
   '-do all erasing-
   GOSUB EraseCube    'fill cube's bounding box with black
  
   IF variableOutput = true THEN GOSUB ErasePrint
  
   GOSUB GetKey
   GOSUB Motion         'inc/dec angles based on rates
LOOP WHILE done = false
END

'|---------------------------------------------|
'|---------- END MAIN PROGRAM -----------------|
'|---------------------------------------------|


RotatePoints:
   FOR n = 1 TO NumPoints
      trans(n).x = cubePoint(n).x 'restore original cube data
      trans(n).y = cubePoint(n).y
      trans(n).z = cubePoint(n).z
      GOSUB DoXAxis                 'translation equations
      GOSUB DoYAxis
      GOSUB DoZAxis
      trans(n).x = xLoc + temp.x
      trans(n).y = yLoc + temp.y
      trans(n).z = zLoc + temp.z
  NEXT
RETURN

DoXAxis:
   '-rotate on x axis-
   'x is unaltered
   temp.y = ccos(xDeg) * trans(n).y - csin(xDeg) * trans(n).z
   temp.z = csin(xDeg) * trans(n).y + ccos(xDeg) * trans(n).z
  
   '-put new values into translated array-
   'x is unaltered
   trans(n).y = temp.y
   trans(n).z = temp.z
RETURN

DoYAxis:
   '-rotate on y axis-
   temp.x = ccos(yDeg) * trans(n).x + csin(yDeg) * trans(n).z
   'y is unaltered
   temp.z = (-csin(yDeg)) * trans(n).x + ccos(yDeg) * trans(n).z
  
   '-put new values into translated array-
   trans(n).x = temp.x
   'y is unaltered
   trans(n).z = temp.z
RETURN

DoZAxis:
   '-rotate on z axis-
   temp.x = ccos(zDeg) * trans(n).x - csin(zDeg) * trans(n).y
   temp.y = csin(zDeg) * trans(n).x + ccos(zDeg) * trans(n).y
   'z is unaltered
  
   '-put new values into translated array-
   trans(n).x = temp.x
   trans(n).y = temp.y
   'z is unaltered
RETURN

FindVisibleSides:
   IF hsr = true THEN
      FOR p = 1 TO 6
         zNorm1 = (cubeVidPoint(polygon(p, 2)).x - cubeVidPoint(polygon(p, 1)).x) * (cubeVidPoint(polygon(p, 1)).y - cubeVidPoint(polygon(p, 3)).y)
         zNorm2 = (cubeVidPoint(polygon(p, 2)).y - cubeVidPoint(polygon(p, 1)).y) * (cubeVidPoint(polygon(p, 1)).x - cubeVidPoint(polygon(p, 3)).x)
         zNorm = zNorm1 - zNorm2
         IF zNorm < 0 THEN visiblePolys(p) = true ELSE visiblePolys(p) = false
      NEXT
   ELSE
      FOR p = 1 TO 6
         visiblePolys(p) = true
      NEXT
   END IF
RETURN

FillPolygons:
   FOR p = 1 TO 6
      IF visiblePolys(p) = true THEN
            FOR n = 1 TO 4
               total = total + cubeVidPoint(polygon(p, n)).x
            NEXT
            midPoint.x = total / 4
            total = 0
           
            FOR n = 1 TO 4
               total = total + cubeVidPoint(polygon(p, n)).y
            NEXT
            midPoint.y = total / 4
            total = 0
            PAINT (midPoint.x, midPoint.y), 4, 15
      END IF
  NEXT
RETURN

Motion:     'make sure degrees are in range of look-up tables
   xDeg = xDeg + xRate
   IF xDeg < 0 THEN xDeg = 359 + xDeg           'add the negative value to
   IF xDeg > 359 THEN xDeg = 0 + (xDeg - 359)   'be more accurate
     
   yDeg = yDeg + yRate
   IF yDeg < 0 THEN yDeg = 359 + yDeg
   IF yDeg > 359 THEN yDeg = 0 + (yDeg - 359)
                
   zDeg = zDeg + zRate
   IF zDeg < 0 THEN zDeg = 359 + zDeg
   IF zDeg > 359 THEN zDeg = 0 + (zDeg - 359)
RETURN

ProjectPoints:
   'project 3d coordinates into 2d integer screen coordinates suitible for
   'VGA and store them in an array
   FOR n = 1 TO NumPoints
      project = trans(n).z + ZOff
      cubeVidPoint(n).x = ((HScale * trans(n).x) / project) + XOff
      cubeVidPoint(n).y = ((VScale * trans(n).y) / project) + YOff
   NEXT
RETURN

EraseCube:
   FOR n = 1 TO 2
      boxErase(n).x = 160: boxErase(n).y = 100  'start from center of screen
   NEXT
   FOR n = 1 TO NumPoints
      IF cubeVidPoint(n).x < boxErase(1).x THEN boxErase(1).x = cubeVidPoint(n).x
      IF cubeVidPoint(n).x > boxErase(2).x THEN boxErase(2).x = cubeVidPoint(n).x
      IF cubeVidPoint(n).y < boxErase(1).y THEN boxErase(1).y = cubeVidPoint(n).y
      IF cubeVidPoint(n).y > boxErase(2).y THEN boxErase(2).y = cubeVidPoint(n).y
   NEXT
   'fill in bouding box with black
   LINE (boxErase(1).x, boxErase(1).y)-(boxErase(2).x, boxErase(2).y), 0, BF
RETURN

OutlinePolygon:   'where n is the polygon to outline
   FOR I = 1 TO 3
      LINE (cubeVidPoint(polygon(n, I)).x, cubeVidPoint(polygon(n, I)).y)-(cubeVidPoint(polygon(n, I + 1)).x, cubeVidPoint(polygon(n, I + 1)).y), OutlineColor
   NEXT
   LINE (cubeVidPoint(polygon(n, 4)).x, cubeVidPoint(polygon(n, 4)).y)-(cubeVidPoint(polygon(n, 1)).x, cubeVidPoint(polygon(n, 1)).y), OutlineColor
RETURN

UpdateFrameRate:  'I don't know if these numbers are right
   frameRate = frameRate + 1
   timeTemp = INT(TIMER)
   IF timeTemp > nextSec THEN    'one full second has passed
      LOCATE 23, 1:  PRINT frameRate: frameRate = 0
      timeTemp = INT(TIMER)
      nextSec = timeTemp + 1
   END IF
RETURN

GetKey:
   k$ = INKEY$
   SELECT CASE k$
      CASE "8"
         xRate = xRate - 1
      CASE "2"
         xRate = xRate + 1
      CASE "4"
         yRate = yRate + 1
      CASE "6"
         yRate = yRate - 1
      CASE "7"
         zRate = zRate - 1
      CASE "9"
         zRate = zRate + 1
      CASE "5"
         xRate = 0: yRate = 0: zRate = 0
      CASE "+"
         FOR n = 1 TO NumPoints
            zLoc = zLoc + 1
         NEXT
      CASE "-"
         FOR n = 1 TO NumPoints
            zLoc = zLoc - 1
         NEXT
      CASE CHR$(0) + "K"     'left
         FOR n = 1 TO NumPoints
            xLoc = xLoc + 1
         NEXT
      CASE CHR$(0) + "M"    'right
         FOR n = 1 TO NumPoints
            xLoc = xLoc - 1
         NEXT
      CASE CHR$(0) + "H"     'up
         FOR n = 1 TO NumPoints
            yLoc = yLoc + 1
         NEXT
      CASE CHR$(0) + "P"     'down
         FOR n = 1 TO NumPoints
            yLoc = yLoc - 1
         NEXT
      CASE "0"
         xRate = 0: yRate = 0: zRate = 0
         xDeg = 0: yDeg = 0: zDeg = 0
         xLoc = 0: yLoc = 0: zLoc = 0
         RESTORE CubeData
         FOR n = 1 TO NumPoints
            READ cubePoint(n).x
            READ cubePoint(n).y
            READ cubePoint(n).z
         NEXT
      CASE "p"
         IF variableOutput = true THEN
            variableOutput = false
         ELSE
         IF variableOutput = false THEN variableOutput = true
         END IF
      CASE "h"
         IF hsr = true THEN
            hsr = false
         ELSE
            IF hsr = false THEN hsr = true
         END IF
      CASE "f"
         IF filled = true THEN
            filled = false
         ELSE
         IF filled = false THEN filled = true
         END IF
      CASE CHR$(27)
         done = true
   END SELECT
RETURN

PrintOut:
   LOCATE 2, 2: PRINT "X:"
   LOCATE 2, 4: PRINT xDeg
   LOCATE 2, 8: PRINT " at rate of "
   LOCATE 2, 19: PRINT xRate
  
   LOCATE 3, 2: PRINT "Y:"
   LOCATE 3, 4: PRINT yDeg
   LOCATE 3, 8: PRINT " at rate of "
   LOCATE 3, 19: PRINT yRate
  
   LOCATE 4, 2: PRINT "Z:"
   LOCATE 4, 4: PRINT zDeg
   LOCATE 4, 8: PRINT " at rate of "
   LOCATE 4, 19: PRINT zRate
RETURN

ErasePrint:
   LOCATE 2, 2: PRINT "             "
   LOCATE 3, 2: PRINT "             "
   LOCATE 4, 2: PRINT "             "
RETURN

CubeData:
DATA 10,10,-10
DATA -10,10,-10
DATA 10,-10,-10
DATA -10,-10,-10

DATA 10,10,10
DATA -10,10,10
DATA 10,-10,10
DATA -10,-10,10

PolygonData:
'top
DATA 1,2,6,5
'front
DATA 5,6,8,7
'bottom
DATA 7,8,4,3
'back
DATA 2,1,3,4
'left
DATA 1,5,7,3
'right
DATA 6,2,4,8