'===========================================================================
' Subject: MOVING IN 3D: DEMO                Date: 07-25-99 (14:37)       
' Author:  Devin Garner                      Code: QB, QBasic, PDS        
' Origin:  santa@tir.com                   Packet: DEMOS.ABC
'===========================================================================
DECLARE SUB getdata ()
DECLARE SUB getkey ()
DECLARE SUB morph ()
DECLARE SUB instruct ()
 
'********************************VARIABLES************************************

COMMON SHARED vx, vy, vz, srx, sry, x, y, z, xspeed, yspeed, zspeed, past, sx, sy

vx = 320 ' viewers X coordinate
vy = 175 ' viewers Y coordinate
vz = 0 ' viewers Z coordinate

srx = 639 ' screens X-resolution
sry = 349 ' screens Y-resolution

xspeed = 25   ' Speed of X axis
yspeed = 25    ' Speed of Y axis
zspeed = .5    ' Speed of Z axis

'*****************************END OF VARIABLES********************************

'****************************OBJECT+COORDINATES*******************************

'rect = rectangle
'rect=DATA rect,col,col2,x,y,z,x,y,z  closest-top-left, farthest-bottom-right
DATA rect,7,40,40,20,80,310,25
DATA rect,7,40,40,0,80,310,15
DATA rect,7,560,40,0,600,310,5
DATA rect,7,560,40,10,600,310,15
DATA done

'******************************END COORDINATES********************************

instruct ' sub: show instructions

10 CLS
getdata ' reads data, and draws it
PCOPY 1, 0
getkey ' gets a key from keyboard
GOTO 10

SUB getdata
RESTORE
20 past = 0
READ comand$
IF comand$ = "done" THEN EXIT SUB

IF comand$ = "rect" THEN
READ col, x1, y1, z1, x2, y2, z2

x = x1
y = y1
z = z1
morph
px1 = sx
py1 = sy
z = z2
morph
px2 = sx
py2 = sy
x = x2
y = y2
morph
px4 = sx
py4 = sy
z = z1
morph
px3 = sx
py3 = sy

IF vx >= x1 AND vx <= x2 AND vz < z2 THEN
IF past = 0 THEN LINE (px1, py1)-(px3, py3), col, B
IF vy < y1 THEN LINE (px1, py1)-(px2, py2), col: LINE (px2, py2)-(px4, py2), col: LINE (px3, py1)-(px4, py2), col
IF vy > y2 THEN LINE (px1, py3)-(px2, py4), col: LINE (px2, py4)-(px4, py4), col: LINE (px3, py3)-(px4, py4), col
GOTO 20
END IF

IF vx > x2 AND vz < z2 THEN
IF vy < y1 THEN LINE (px1, py1)-(px2, py2), col: LINE (px2, py2)-(px4, py2), col
IF vy > y2 THEN LINE (px1, py3)-(px2, py4), col: LINE (px2, py4)-(px4, py4), col
IF past = 0 THEN LINE (px1, py1)-(px3, py3), col, B
LINE (px3, py3)-(px4, py4), col
LINE (px3, py1)-(px4, py2), col
LINE (px4, py2)-(px4, py4), col
GOTO 20
END IF

IF vx < x2 AND vz < z2 THEN
IF vy < y1 THEN LINE (px3, py1)-(px4, py2), col: LINE (px2, py2)-(px4, py2), col
IF vy > y2 THEN LINE (px3, py3)-(px4, py4), col: LINE (px2, py4)-(px4, py4), col
IF past = 0 THEN LINE (px1, py1)-(px3, py3), col, B
LINE (px1, py3)-(px2, py4), col
LINE (px1, py1)-(px2, py2), col
LINE (px2, py4)-(px2, py2), col
GOTO 20
END IF

GOTO 20

END IF
END SUB

SUB getkey
DO
key$ = INKEY$
LOOP UNTIL key$ <> ""
SELECT CASE ASC(RIGHT$(key$, 1))
        CASE 27
                SYSTEM
       
        CASE 75
                IF left = 0 THEN vx = vx - xspeed: left = 0

        CASE 77
                IF right = 0 THEN vx = vx + xspeed: right = 0
       
        CASE 97
                
                vy = vy - yspeed

        CASE 122

                vy = vy + yspeed
       
        CASE 72
                IF forward = 0 THEN vz = vz + zspeed: forward = 0
  
        CASE 80
                vz = vz - zspeed
        CASE 97 ' a
               vy = vy - yspeed

        CASE 122 ' z
               vy = vy + yspeed
        CASE 72 ' up
                IF forward = 0 THEN vz = vz + zspeed: forward = 0
        CASE 80 ' down
                vz = vz - zspeed
        CASE ELSE
              getkey
END SELECT
END SUB

SUB instruct
SCREEN 0
CLS
PRINT "3D Demo In QB BY: Devin Garner"
PRINT CHR$(27); " Sidesteps left"
PRINT CHR$(26); " Sidesteps right"
PRINT CHR$(24); " Steps Forward"
PRINT CHR$(25); " Steps Backward"
PRINT
PRINT "press any key to continue"
SLEEP
SCREEN 9, 0, 1, 0
END SUB

SUB morph
IF vz >= z THEN z = vz + zspeed: past = 1  'fix error and make it look right if ur pastit
sx = (x - vx) / (z - vz) + srx / 2' changes the 3D variables to 2D
sy = (y - vy) / (z - vz) + sry / 2' changes the 3D variables to 2D
END SUB