mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-07-06 04:40:23 +00:00
9ee89d6ff4
These tests use a variety of sample code (with some of the larger files removed, so they are not complete!) and verifies that they all compile successfully.
436 lines
13 KiB
QBasic
436 lines
13 KiB
QBasic
'3DEXP2.BAS By Rich Geldreich June 2nd, 1992
|
|
'A fast, QuickBASIC 4.5 3-D wireframe animation program.
|
|
'Compile it for maximum speed!
|
|
'If you have any questions or ideas, please write/call:
|
|
|
|
'Rich Geldreich
|
|
'410 Market St.
|
|
'Gloucester City, NJ 08030
|
|
'(609)-742-8752
|
|
|
|
'The following program is in the public domain! Have fun!
|
|
'Also look at VECT.ASM
|
|
DEFINT A-Z
|
|
TYPE LineType
|
|
X AS INTEGER
|
|
Y AS INTEGER
|
|
Z AS INTEGER
|
|
X1 AS INTEGER
|
|
Y1 AS INTEGER
|
|
Z1 AS INTEGER
|
|
END TYPE
|
|
DIM Points(100) AS LineType
|
|
DIM Xn(100), Yn(100), Zn(100)
|
|
DIM Xs1(100), Ys1(100), Xe1(100), Ye1(100)
|
|
DIM X(100), Y(100), Z(100), Pointers1(100), Pointers2(100), Sp(100), Zp(100)
|
|
DIM R(100), B(63), B1(63)
|
|
DIM Cosine&(360), Sine&(360)
|
|
CLS
|
|
PRINT "3-D Craft v1a"
|
|
PRINT "By Rich Geldreich June 2nd, 1992"
|
|
PRINT
|
|
PRINT "Keys to use: (Turn NUMLOCK on!)"
|
|
PRINT "Q...............Quits"
|
|
PRINT "Numeric keypad..Controls your position(press 5 on the keypad"
|
|
PRINT " to completly stop yourself) "
|
|
PRINT "-...............Forward exceleration"
|
|
PRINT "+...............Backward exceleration"
|
|
PRINT "Arrow keys......Controls the rotation of the craft"
|
|
PRINT "F...............Excelerates the craft (Forward)"
|
|
PRINT "B...............Slows the craft (Backward)"
|
|
PRINT "S...............Stops the craft"
|
|
PRINT "A...............Toggles Auto Center, use this when you lose";
|
|
PRINT " the craft"
|
|
PRINT "C...............Stops the craft's rotation"
|
|
PRINT "V...............Resets the craft to starting position"
|
|
PRINT
|
|
PRINT "Wait a sec..."
|
|
|
|
'The following for/next loop makes a sine & cosine table.
|
|
'Each sine & cosine is multiplied by 1024 and stored as long integers.
|
|
'This is done so that we don't have to use any slow floating point
|
|
'math at run time.
|
|
A = 0
|
|
FOR A! = 0 TO 359 / 57.29577951# STEP 1 / 57.29577951#
|
|
Cosine&(A) = INT(.5 + COS(A!) * 1024)
|
|
Sine&(A) = INT(.5 + SIN(A!) * 1024): A = A + 1
|
|
NEXT
|
|
'Next we read in all of the lines that are in the object...
|
|
FOR A = 0 TO 44
|
|
READ Points(A).X, Points(A).Y, Points(A).Z
|
|
READ Points(A).X1, Points(A).Y1, Points(A).Z1
|
|
NEXT
|
|
'Here comes the hard part... Consider this scenario:
|
|
|
|
'We have two connected lines, like this:
|
|
|
|
' 1--------2 and 3
|
|
' |
|
|
' |
|
|
' |
|
|
' |
|
|
' 4
|
|
'Where 1,2, 3, & 4 are the starting and ending points of each line.
|
|
'The first line consists of points 1 & 2 and the second line
|
|
'is made of points 3 & 4.
|
|
'So, you ask, what's wrong? Nothing, really, but don't you see that
|
|
'points 2 and 3 are really at the sample place? Why rotate them twice,
|
|
'that would be a total waste of time? The following code eliminates such
|
|
'occurrences from the line table. (great explanation, huh?)
|
|
|
|
NumberLines = 45
|
|
'take all of the starting & ending points and put them in one big
|
|
'array...
|
|
Np = 0
|
|
FOR A = 0 TO NumberLines - 1
|
|
X(Np) = Points(A).X
|
|
Y(Np) = Points(A).Y
|
|
Z(Np) = Points(A).Z
|
|
Np = Np + 1
|
|
X(Np) = Points(A).X1
|
|
Y(Np) = Points(A).Y1
|
|
Z(Np) = Points(A).Z1
|
|
Np = Np + 1
|
|
NEXT
|
|
'Now set up two sets of pointers that point to each point that a line
|
|
'is made of... (in other words, scan for the first occurrence of each
|
|
'starting and ending point in the point array we just built...)
|
|
FOR A = 0 TO NumberLines - 1
|
|
Xs = Points(A).X
|
|
Ys = Points(A).Y
|
|
Zs = Points(A).Z 'get the 3 coordinates of the start point
|
|
FOR B = 0 TO Np - 1 'scan the point array
|
|
IF X(B) = Xs AND Y(B) = Ys AND Z(B) = Zs THEN
|
|
Pointers1(A) = B 'set the pointer to point to the
|
|
EXIT FOR 'point we have just found
|
|
END IF
|
|
NEXT
|
|
Xs = Points(A).X1 'do the same thing that we did above
|
|
Ys = Points(A).Y1 'except scan for the ending point
|
|
Zs = Points(A).Z1 'of each line
|
|
FOR B = 0 TO Np - 1
|
|
IF X(B) = Xs AND Y(B) = Ys AND Z(B) = Zs THEN
|
|
Pointers2(A) = B
|
|
EXIT FOR
|
|
END IF
|
|
NEXT
|
|
NEXT
|
|
'Okay, were almost done! All we have to do now is to build a table
|
|
'that tells us which points to actually rotate...
|
|
Nr = 0
|
|
FOR A = 0 TO NumberLines - 1
|
|
F1 = Pointers1(A) 'get staring & ending point number
|
|
S1 = Pointers2(A)
|
|
IF Nr = 0 THEN 'if this is the first point then it of course
|
|
'has to be rotated
|
|
R(Nr) = F1: Nr = Nr + 1
|
|
ELSE
|
|
Found = 0 'scan to see if this point already exists...
|
|
FOR B = 0 TO Nr - 1
|
|
IF R(B) = F1 THEN
|
|
Found = -1: EXIT FOR 'shoot, it's already here!
|
|
END IF
|
|
NEXT
|
|
IF NOT Found THEN R(Nr) = F1: Nr = Nr + 1 'point the point
|
|
'in the array it we
|
|
END IF 'can't find it...
|
|
|
|
Found = 0 'now look for the ending point
|
|
FOR B = 0 TO Nr - 1
|
|
IF R(B) = S1 THEN
|
|
Found = -1: EXIT FOR
|
|
END IF
|
|
NEXT
|
|
IF NOT Found THEN R(Nr) = S1: Nr = Nr + 1
|
|
NEXT
|
|
FOR A = 0 TO 63
|
|
B(A) = (4 * A) \ 8
|
|
B1(A) = A - B(A)
|
|
NEXT
|
|
PRINT "Press any key to begin..."
|
|
A$ = INPUT$(1)
|
|
|
|
Deg1 = 0: Deg2 = 0: D1 = 0: D2 = 0
|
|
|
|
Spos = -200: Mypos = 0
|
|
|
|
Mx = 0: My = 0: Mz = 0: Ox = 0: Oy = 0: Oz = -260
|
|
|
|
NumberOfFrames = 0
|
|
DEF SEG = &H40
|
|
StartTime = PEEK(&H6C)
|
|
|
|
SCREEN 13
|
|
FOR A = 0 TO 63
|
|
OUT &H3C7, A: OUT &H3C8, A: OUT &H3C9, A: OUT &H3C9, 0: OUT &H3C9, 0
|
|
NEXT
|
|
|
|
DO
|
|
|
|
|
|
|
|
Deg1 = (Deg1 + D1) MOD 360
|
|
Deg2 = (Deg2 + D2) MOD 360
|
|
IF Deg1 < 0 THEN Deg1 = Deg1 + 360
|
|
IF Deg2 < 0 THEN Deg2 = Deg2 + 360
|
|
|
|
C1& = Cosine&(Deg1): S1& = Sine&(Deg1)
|
|
C2& = Cosine&(Deg2): S2& = Sine&(Deg2)
|
|
C3& = Cosine&(Deg3): S3& = Sine&(Deg3)
|
|
'Deg3 = (Deg3 + 5) MOD 360
|
|
|
|
X = Speed: Y = 0: Z = 0
|
|
|
|
X1 = (X * C1&) \ 1024: Y1 = (X * S1&) \ 1024
|
|
X2 = (X1 * C2&) \ 1024: Zn = (X1 * S2&) \ 1024
|
|
|
|
Y3 = (Y1 * C3& - Zn * S3&) \ 1024
|
|
Z3 = (Y1 * S3& + Zn * C3&) \ 1024
|
|
|
|
Ox = Ox + X2: Oy = Oy + Y3: Oz = Oz + Z3
|
|
IF Oz > 32000 THEN Oz = 32000
|
|
IF Oz < -32000 THEN Oz = -32000
|
|
IF Ox > 32000 THEN Ox = 32000
|
|
IF Ox < -32000 THEN Ox = -32000
|
|
IF Oy > 32000 THEN Oy = 32000
|
|
IF Oy < -32000 THEN Oy = -32000
|
|
|
|
|
|
IF AtLoc THEN
|
|
Mx = Mx + (Ox - Mx) \ 4
|
|
My = My + (Oy - My) \ 4
|
|
Mz = Mz + ((Oz + 200) - Mz) \ 4
|
|
ELSE
|
|
'adjust the users position based on how much he is moving...
|
|
Mz = Mz + Mzm: Mx = Mx + Mxm: My = My + Mym
|
|
IF Mz > 32000 THEN Mz = 32000
|
|
IF Mz < -32000 THEN Mz = -32000
|
|
IF Mx > 32000 THEN Mx = 32000
|
|
IF Mx < -32000 THEN Mx = -32000
|
|
IF My > 32000 THEN My = 32000
|
|
IF My < -32000 THEN My = -32000
|
|
END IF
|
|
|
|
LOCATE 1, 1: PRINT A$
|
|
|
|
MaxZ = -32768
|
|
LowZ = 32767
|
|
FOR A = 0 TO Nr - 1
|
|
R = R(A)
|
|
Xo = X(R): Yo = Y(R): Zo = Z(R)
|
|
|
|
X1 = (Xo * C1& - Yo * S1&) \ 1024
|
|
Y1 = (Xo * S1& + Yo * C1&) \ 1024
|
|
|
|
X2& = (X1 * C2& - Zo * S2&) \ 1024 - Mx + Ox
|
|
Z2 = (X1 * S2& + Zo * C2&) \ 1024
|
|
|
|
Y3& = (Y1 * C3& - Z2 * S3&) \ 1024 - My + Oy
|
|
Z4 = (Y1 * S3& + Z2 * C3&) \ 1024
|
|
|
|
Z3 = Z4 - Mz + Oz
|
|
|
|
|
|
Zn(R) = Z4
|
|
IF Z4 > MaxZ THEN MaxZ = Z4
|
|
IF Z4 < LowZ THEN LowZ = Z4
|
|
|
|
'X2&,Y3&,Z3
|
|
|
|
'if the point is too close(or behind) the viewer then
|
|
'don't draw it...
|
|
IF (Mypos - Z3) < 15 THEN
|
|
Xn(R) = -1000: Yn(R) = 0: Zn = 0
|
|
ELSE
|
|
V = (1330& * (Spos - Z3)) \ (Mypos - Z3)
|
|
Xn(R) = 160 + X2& + (-X2& * V) \ 1330
|
|
Yn(R) = 100 + (8 * (Y3& + (-Y3& * V) \ 1330)) \ 10
|
|
END IF
|
|
NEXT
|
|
|
|
MaxZ = MaxZ - LowZ
|
|
|
|
|
|
Nl = 0
|
|
FOR A = 0 TO NumberLines - 1
|
|
F1 = Pointers1(A): S1 = Pointers2(A)
|
|
IF Xn(F1) <> -1000 AND Xn(S1) <> -1000 THEN
|
|
Sp(Nl) = A
|
|
Zp(A) = (Zn(F1) + Zn(S1)) \ 2
|
|
Nl = Nl + 1
|
|
END IF
|
|
NEXT
|
|
Nl = Nl - 1
|
|
'sort lines according to their Z coordinates
|
|
IF Nl > -1 THEN
|
|
Mid = Nl \ 2
|
|
DO
|
|
FOR A = 0 TO Nl - Mid
|
|
IF Zp(Sp(A)) > Zp(Sp(A + Mid)) THEN
|
|
SWAP Sp(A), Sp(A + Mid)
|
|
CL = A - Mid
|
|
CH = A
|
|
DO WHILE CL >= 0
|
|
IF Zp(Sp(CL)) > Zp(Sp(CH)) THEN
|
|
SWAP Sp(CL), Sp(CH)
|
|
CH = CL
|
|
CL = CL - Mid
|
|
ELSE
|
|
EXIT DO
|
|
END IF
|
|
LOOP
|
|
END IF
|
|
NEXT
|
|
Mid = Mid \ 2
|
|
LOOP WHILE Mid > 0
|
|
END IF
|
|
'wait for vertical retrace
|
|
WAIT &H3DA, 8
|
|
'erase old points
|
|
FOR A = Ln - 1 TO 0 STEP -1
|
|
LINE (Xs1(A), Ys1(A))-(Xe1(A), Ye1(A)), 0
|
|
NEXT
|
|
|
|
Ln = 0
|
|
FOR A1 = 0 TO Nl
|
|
A = Sp(A1)
|
|
|
|
Z = Zp(A)
|
|
F1 = Pointers1(Sp(A1)): S1 = Pointers2(Sp(A1))
|
|
|
|
Xn = Xn(F1): Yn = Yn(F1)
|
|
|
|
IF Xn <> -1000 THEN
|
|
X1 = Xn(S1)
|
|
IF X1 <> -1000 THEN
|
|
Y1 = Yn(S1)
|
|
Z1 = (Z - Mz + Oz)
|
|
|
|
IF Z1 > -1500 THEN
|
|
'calculate color
|
|
T = 63 - ((Z1 * -63&) \ 1500)
|
|
C = B1(T) + (B(T) * (Z - LowZ)) \ MaxZ
|
|
'draw line
|
|
LINE (X1, Y1)-(Xn, Yn), C
|
|
'store for later
|
|
Xs1(Ln) = X1: Ys1(Ln) = Y1
|
|
Xe1(Ln) = Xn: Ye1(Ln) = Yn
|
|
Ln = Ln + 1
|
|
END IF
|
|
END IF
|
|
END IF
|
|
NEXT
|
|
'process keystroke
|
|
K$ = UCASE$(INKEY$)
|
|
'Process the keystroke(if any)...
|
|
IF K$ <> "" THEN
|
|
SELECT CASE K$
|
|
CASE "A"
|
|
AtLoc = NOT AtLoc
|
|
CASE "+"
|
|
Mzm = Mzm + 2
|
|
CASE "-"
|
|
Mzm = Mzm - 2
|
|
CASE "5"
|
|
Mxm = 0: Mym = 0: Mzm = 0
|
|
CASE "4"
|
|
Mxm = Mxm - 2
|
|
CASE "6"
|
|
Mxm = Mxm + 2
|
|
CASE "8"
|
|
Mym = Mym - 2
|
|
CASE "2"
|
|
Mym = Mym + 2
|
|
CASE "F"
|
|
Speed = Speed + 5
|
|
CASE "B"
|
|
Speed = Speed - 5
|
|
CASE "C"
|
|
D1 = 0: D2 = 0
|
|
CASE "S"
|
|
Speed = 0
|
|
CASE CHR$(0) + CHR$(72)
|
|
D1 = D1 + 1
|
|
CASE CHR$(0) + CHR$(80)
|
|
D1 = D1 - 1
|
|
CASE CHR$(0) + CHR$(75)
|
|
D2 = D2 - 1
|
|
CASE CHR$(0) + CHR$(77)
|
|
D2 = D2 + 1
|
|
CASE "Q", CHR$(27)
|
|
SCREEN 0, , 0, 0: WIDTH 80
|
|
CLS
|
|
PRINT "By Rich Geldreich June 2nd, 1992"
|
|
PRINT "See ya later!"
|
|
END
|
|
CASE "V"
|
|
D1 = 0: D2 = 0: Deg1 = 0: Deg2 = 0: Speed = 0
|
|
END SELECT
|
|
END IF
|
|
'NumberOfFrames = NumberOfFrames + 1
|
|
'see if 20 frames have passed; if so then see
|
|
'how long it took...
|
|
'IF NumberOfFrames = 20 THEN
|
|
' TotalTime = PEEK(&H6C) - StartTime
|
|
' IF TotalTime < 0 THEN TotalTime = TotalTime + 256
|
|
' FramesPerSecX100 = 36400 \ TotalTime
|
|
' High = FramesPerSecX100 \ 100
|
|
' Low = FramesPerSecX100 - High
|
|
' 'A$ has the string that is printed at the upper left
|
|
' 'corner of the screen
|
|
' A$ = MID$(STR$(High), 2) + "."
|
|
' A$ = A$ + RIGHT$("0" + MID$(STR$(Low), 2), 2) + " "
|
|
' NumberOfFrames = 0
|
|
' StartTime = PEEK(&H6C)
|
|
'END IF
|
|
LOOP
|
|
'The following data is the shuttle craft...
|
|
'stored as Start X,Y,Z & End X,Y,Z
|
|
DATA -157,22,39,-157,-18,39
|
|
DATA -157,-18,39,-127,-38,39
|
|
DATA -127,-38,39,113,-38,39
|
|
DATA 113,-38,39,193,12,39
|
|
DATA 33,42,39,33,42,-56
|
|
DATA 33,42,-56,-127,42,-56
|
|
DATA -127,42,-56,-157,22,-56
|
|
DATA -157,22,-56,-157,22,39
|
|
DATA -157,22,-56,-157,-18,-56
|
|
DATA -157,-18,-56,-157,-18,39
|
|
DATA -157,-18,-56,-127,-38,-56
|
|
DATA -127,-38,-56,-127,-38,39
|
|
DATA -127,-38,-56,113,-38,-56
|
|
DATA 113,-38,-56,113,-38,39
|
|
DATA 113,-38,-56,193,12,-56
|
|
DATA 193,12,-56,193,12,39
|
|
DATA -157,22,-56,193,12,-56
|
|
DATA 193,12,39,-157,22,39
|
|
DATA -56,-13,41,-56,-3,41
|
|
DATA -56,-3,41,-26,-3,41
|
|
DATA -26,-3,41,-26,7,41
|
|
DATA -51,7,41,-31,-13,41
|
|
DATA -11,-13,41,-11,-3,41
|
|
DATA -11,-3,41,-1,7,41
|
|
DATA 9,7,41,9,-8,41
|
|
DATA 9,-8,41,24,-8,41
|
|
DATA 34,16,41,34,-38,41
|
|
DATA 33,-39,41,33,-39,-53
|
|
DATA 33,-39,-53,33,15,-53
|
|
DATA -42,-38,19,-72,-38,19
|
|
DATA -72,-38,19,-72,-38,-41
|
|
DATA -72,-38,-41,-42,-38,-41
|
|
DATA -42,-38,-41,-42,-38,19
|
|
DATA 33,42,39,34,16,41
|
|
DATA 33,42,-56,33,15,-53
|
|
DATA -157,22,39,-127,42,39
|
|
DATA -127,42,-56,-127,42,39
|
|
DATA -127,42,39,33,42,39
|
|
DATA 159,-8,-56,159,-8,40
|
|
DATA 143,-18,-56,143,-18,39
|
|
DATA 193,12,39,193,32,30
|
|
DATA 33,42,39,193,32,30
|
|
DATA 193,32,30,193,32,-47
|
|
DATA 33,42,-56,193,32,-47
|
|
DATA 193,12,-56,193,32,-47
|
|
|
|
|