'===========================================================================
' Subject: BILL'S FIRST 3D ENGINE V1.0       Date: 12-04-98 (21:22)       
' Author:  Bill McDonald                     Code: QB, QBasic, PDS        
' Origin:  alterac@id-base.com             Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB Pal (Col%, R%, G%, B%)
DECLARE SUB SetPalette ()
'B3d V1.0 Bill's 3d engine
'===========================
'I think this is pretty good for my first success in 3d
'any help would be apreciated
'alterac@id-base.com
DEFINT A-Z
DECLARE SUB MoveAround ()
DECLARE FUNCTION rad& (theta%)
DECLARE SUB SetUpPoints ()
DECLARE SUB MoveAcint ()
DECLARE SUB RotatePoints (x%, y%, z%)
DECLARE SUB DrawPoints ()
DECLARE SUB ClearPoints ()

CONST MaxLines = 12, Pi = 3.141592

DIM SHARED Obj(MaxLines, 2, 3)
 FOR I = 1 TO MaxLines
  FOR J = 1 TO 2
   FOR K = 1 TO 3
    READ Obj(I, J, K)
   NEXT K
  NEXT J
 NEXT I

 'Square
 DATA -10,-10,-10, 10,-10,-10
 DATA -10,-10,-10,-10, 10,-10
 DATA -10, 10,-10, 10, 10,-10
 DATA  10,-10,-10, 10, 10,-10
 DATA -10,-10, 10, 10,-10, 10
 DATA -10,-10, 10,-10, 10, 10
 DATA -10, 10, 10, 10, 10, 10
 DATA  10,-10, 10, 10, 10, 10
 DATA -10,-10, 10,-10,-10,-10
 DATA -10, 10, 10,-10, 10,-10
 DATA  10, 10, 10, 10, 10,-10
 DATA  10,-10, 10, 10,-10,-10
  
 'The 3-D coordinates of our object ... stored as (X1,Y1,Z1),
 '(X2,Y2,Z2) ... for the two ends of a line

TYPE Points
      x AS DOUBLE
      y AS DOUBLE
      z AS DOUBLE                         ' The data on every point we rotate
END TYPE

DIM SHARED Lines(MaxLines, 2) AS Points            ' The base object rotated
DIM SHARED translated(MaxLines, 2) AS Points       ' The rotated object
DIM SHARED xoff, yoff, Zoff                        ' Used for movement of the object
DIM SHARED lookup(360, 2) AS DOUBLE                ' Our sin and cos lookup tableDIM SHARED temp AS Points

RANDOMIZE TIMER
SCREEN 13
SetUpPoints
MoveAround
SCREEN 0: WIDTH 80

SUB ClearPoints
  'This clears the translated object from the virtual screen ... believe it
  '  or not, this is faster then a straight "cls"


  FOR Loop1 = 1 TO MaxLines
    IF (translated(Loop1, 1).z + Zoff < 0) AND (translated(Loop1, 2).z + Zoff < 0) THEN
      temp.z = CINT(translated(Loop1, 1).z + Zoff)
      nx = CINT(256 * translated(Loop1, 1).x) \ temp.z + xoff
      ny = CINT(256 * translated(Loop1, 1).y) \ temp.z + yoff
      temp.z = CINT(translated(Loop1, 2).z + Zoff)
      nx2 = CINT(256 * translated(Loop1, 2).x) \ temp.z + xoff
      ny2 = CINT(256 * translated(Loop1, 2).y) \ temp.z + yoff
      LINE (nx, ny)-(nx2, ny2), 0
    END IF
  NEXT
END SUB

SUB DrawPoints
' This draws the translated object to the screen
  FOR Loop1 = 1 TO MaxLines
    IF (translated(Loop1, 1).z + Zoff < 0) AND (translated(Loop1, 2).z + Zoff < 0) THEN
      temp.z = CINT(translated(Loop1, 1).z + Zoff)
      nx = CINT(256 * translated(Loop1, 1).x) \ temp.z + xoff
      ny = CINT(256 * translated(Loop1, 1).y) \ temp.z + yoff
      temp.z = CINT(translated(Loop1, 2).z + Zoff)
      nx2 = CINT(256 * translated(Loop1, 2).x) \ temp.z + xoff
      ny2 = CINT(256 * translated(Loop1, 2).y) \ temp.z + yoff
      '*IF (nx > 0) AND (nx < 320) AND (ny > 25) AND (ny < 200) AND (nx2 > 0) AND (nx2 < 320) AND (ny2 > 25) AND (ny2 < 200) THEN
      LINE (nx, ny)-(nx2, ny2), 14
    END IF
  NEXT
'* Checks If line draws out of x > 320, y > 200, Y < 0, X < 0
END SUB

SUB MoveAround
  'This is the main display procedure. Firstly it brings the object towards
  '  the viewer by increasing the Zoff, then passes control to the user
  deg = 0
  CLS

  'Smaller the Zoff the Bigger the Object
  'Zooms in Rotating
  FOR Loop1 = -256 TO -40
    Zoff = Loop1 * 2
    RotatePoints Yaw, Pitch, Roll
    DrawPoints

    WAIT &H3DA, 8
   
    ClearPoints
    
    'yaw = (yaw + 5) MOD 360
    'pitch = (pitch + 5) MOD 360
    Roll = (Roll + 5) MOD 360
  NEXT Loop1
 
  P = 3
  ST! = TIMER
  DO
    A$ = INKEY$
    IF A$ <> "" THEN
      SELECT CASE A$
        CASE "A", "a"
         Zoff = Zoff + 5    'Zoff + 5 = Zoom In
         IF Zoff = 0 THEN Zoff = Zoff + 5
        CASE "Z", "z"
         Zoff = Zoff - 5    'Zoom  Out
         IF Zoff = 0 THEN Zoff = Zoff - 5
        CASE ","
         xoff = xoff - 5    'Move Left (Transilate)
        CASE "."
         xoff = xoff + 5    'Move Right
        CASE "S", "s"
         yoff = yoff - 5    'Move Up
        CASE "X", "x"
         yoff = yoff + 5    'Move Down
        CASE CHR$(27)
         EXIT DO
      END SELECT
    END IF

    DrawPoints
    WAIT &H3DA, 8
    WAIT &H3DA, 8, 8

    ClearPoints
    RotatePoints Yaw, Pitch, Roll
   
    'Pitch = (Pitch + 5) MOD 360
    Roll = (Roll + 5) MOD 360
    'Yaw = (Yaw + 5) MOD 360
     
    IF TIMER - ST! >= 1 THEN
     ST! = TIMER
     FramesPer = Frames
     Frames = 0
    END IF
    Frames = Frames + 1
    COLOR 15: LOCATE 1, 1: PRINT "FPS:"; FramesPer
  LOOP
END SUB

SUB Pal (Col, R, G, B)
  ' This sets the Red, Green and Blue values of a certain color
      OUT &H3C8, Col
      OUT &H3C9, R
      OUT &H3C9, G
      OUT &H3C9, B
END SUB

FUNCTION rad& (theta)
  'This calculates the degrees of an angle
  rad& = theta * Pi / 180
END FUNCTION

SUB RotatePoints (x, y, z)
  ' This rotates object lines by X,Y and Z; then places the result in
  '  TRANSLATED

  FOR Loop1 = 1 TO MaxLines
    temp.x = Lines(Loop1, 1).x
    temp.y = lookup(x, 2) * Lines(Loop1, 1).y - lookup(x, 1) * Lines(Loop1, 1).z
    temp.z = lookup(x, 1) * Lines(Loop1, 1).y + lookup(x, 2) * Lines(Loop1, 1).z

    translated(Loop1, 1).x = temp.x
    translated(Loop1, 1).y = temp.y
    translated(Loop1, 1).z = temp.z

    IF y > 0 THEN
      temp.x = lookup(y, 2) * translated(Loop1, 1).x - lookup(y, 1) * translated(Loop1, 1).y
      temp.y = lookup(y, 1) * translated(Loop1, 1).x + lookup(y, 2) * translated(Loop1, 1).y
      temp.z = translated(Loop1, 1).z

      translated(Loop1, 1).x = temp.x
      translated(Loop1, 1).y = temp.y
      translated(Loop1, 1).z = temp.z
    END IF

    IF z > 0 THEN
      temp.x = lookup(z, 2) * translated(Loop1, 1).x + lookup(z, 1) * translated(Loop1, 1).z
      temp.y = translated(Loop1, 1).y
      temp.z = -lookup(z, 1) * translated(Loop1, 1).x + lookup(z, 2) * translated(Loop1, 1).z

      translated(Loop1, 1).x = temp.x
      translated(Loop1, 1).y = temp.y
      translated(Loop1, 1).z = temp.z
    END IF

    temp.x = Lines(Loop1, 2).x
    temp.y = COS(rad(x)) * Lines(Loop1, 2).y - SIN(rad(x)) * Lines(Loop1, 2).z
    temp.z = SIN(rad(x)) * Lines(Loop1, 2).y + COS(rad(x)) * Lines(Loop1, 2).z

    translated(Loop1, 2).x = temp.x
    translated(Loop1, 2).y = temp.y
    translated(Loop1, 2).z = temp.z
    
    IF y > 0 THEN
      temp.x = COS(rad(y)) * translated(Loop1, 2).x - SIN(rad(y)) * translated(Loop1, 2).y
      temp.y = SIN(rad(y)) * translated(Loop1, 2).x + COS(rad(y)) * translated(Loop1, 2).y
      temp.z = translated(Loop1, 2).z

      translated(Loop1, 2).x = temp.x
      translated(Loop1, 2).y = temp.y
      translated(Loop1, 2).z = temp.z
    END IF

    IF z > 0 THEN
      temp.x = COS(rad(z)) * translated(Loop1, 2).x + SIN(rad(z)) * translated(Loop1, 2).z
      temp.y = translated(Loop1, 2).y
      temp.z = -SIN(rad(z)) * translated(Loop1, 2).x + COS(rad(z)) * translated(Loop1, 2).z

      translated(Loop1, 2).x = temp.x
      translated(Loop1, 2).y = temp.y
      translated(Loop1, 2).z = temp.z
    END IF
  NEXT Loop1
END SUB

SUB SetUpPoints
  ' This sets the basic offsets of the object, creates the lookup table and
  '  moves the object from a constant to a variable

  xoff = 160
  yoff = 100
  Zoff = -256
  FOR Loop1 = 0 TO 360
    lookup(Loop1, 1) = SIN(rad&(Loop1))
    lookup(Loop1, 2) = COS(rad&(Loop1))
  NEXT
 
  FOR Loop1 = 1 TO MaxLines
    Lines(Loop1, 1).x = Obj(Loop1, 1, 1)
    Lines(Loop1, 1).y = Obj(Loop1, 1, 2)
    Lines(Loop1, 1).z = Obj(Loop1, 1, 3)
   
    Lines(Loop1, 2).x = Obj(Loop1, 2, 1)
    Lines(Loop1, 2).y = Obj(Loop1, 2, 2)
    Lines(Loop1, 2).z = Obj(Loop1, 2, 3)
  NEXT
END SUB