mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-09-28 07:37:47 +00:00
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
|
||
|
|
||
|
|