01-16-2004, 04:07 AM
Here you are, a red/blue wireframe program. kinda flickery though.
Most of the credit goes to Rich Geldreich, who made the original program. I just modified it to do red/blue. Now if only I had a pair of red/blue glasses...
Most of the credit goes to Rich Geldreich, who made the original program. I just modified it to do red/blue. Now if only I had a pair of red/blue glasses...
Code:
DEFINT A-Z
READ max
TYPE LineType
X AS INTEGER
Y AS INTEGER
Z AS INTEGER
X1 AS INTEGER
Y1 AS INTEGER
Z1 AS INTEGER
END TYPE
DIM Points(max * 2) AS LineType
DIM Xn(max * 2), Yn(max * 2), Zn(max * 2)
DIM Xs1(max * 2), Ys1(max * 2), Xe1(max * 2), Ye1(max * 2)
DIM X(max * 2), Y(max * 2), Z(max * 2), Pointers1(max * 2), Pointers2(max * 2), Sp(max * 2), Zp(max * 2)
DIM R(100), B(63), B1(63)
DIM Cosine&(360), Sine&(360)
CLS
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 "X...............Increased offset between red and blue craft"
PRINT "Y...............Decreased offset between red and blue craft"
PRINT
PRINT "Wait a sec..."
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
'OPEN "707.wrfm" FOR INPUT AS #1
'INPUT #1, max
FOR A = 0 TO max - 1
'INPUT #1, Points(A).X, Points(A).Y, Points(A).Z
'INPUT #1, Points(A).X1, Points(A).Y1, Points(A).Z1
READ Points(A).X, Points(A).Y, Points(A).Z
READ Points(A).X1, Points(A).Y1, Points(A).Z1
NEXT
'CLOSE
NumberLines = max
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
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
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 31
OUT &H3C7, A: OUT &H3C8, A: OUT &H3C9, A * 2: OUT &H3C9, 0: OUT &H3C9, 0
NEXT
FOR A = 32 TO 63
OUT &H3C7, A: OUT &H3C8, A: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, (A - 32) * 2
NEXT
offset = -20
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$; offset
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)
IF MaxZ = 0 THEN
c = 0
ELSE
c = B1(T) + (B(T) * (Z - LowZ)) \ MaxZ
END IF
'draw line
IF offset > 0 THEN cc = c / 2 + 32
IF offset < 0 THEN cc = c / 2
LINE (X1, Y1)-(Xn, Yn), cc
'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 "X"
IF offset < 0 THEN offset = offset - 5
IF offset > 0 THEN offset = offset + 5
CASE "Z"
IF offset < 0 THEN offset = offset + 5
IF offset > 0 THEN offset = offset - 5
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
Mxm = offset
offset = offset * -1
LOOP
'The following data is the shuttle craft...
'stored as Start X,Y,Z & End X,Y,Z
'Decent Ship
DATA 66
'center lines
DATA 100,15,70,0,15,70
DATA 100,15,-70,0,15,-70
'right wing
DATA 0,15,-70,-20,10,-60
DATA -20,10,-60,-30,5,-50
DATA -30,5,-50,-40,0,-30
DATA -10,10,-60,-20,5,-50
DATA -20,5,-50,-30,0,-30
DATA -10,10,-60,-20,10,-60
DATA -30,0,-30,-40,0,-30
DATA -40,0,-30,10,0,-30
DATA 50,15,-70,30,10,-60
DATA 30,10,-60,20,5,-50
DATA 20,5,-50,10,0,-30
'left wing
DATA 0,15,70,-20,10,60
DATA -20,10,60,-30,5,50
DATA -30,5,50,-40,0,30
DATA -10,10,60,-20,5,50
DATA -20,5,50,-30,0,30
DATA -10,10,60,-20,10,60
DATA -30,0,30,-40,0,30
DATA -40,0,30,10,0,30
DATA 50,15,70,30,10,60
DATA 30,10,60,20,5,50
DATA 20,5,50,10,0,30
'nose
DATA 10,0,-30,50,0,-25
DATA 50,0,-25,70,0,-15
DATA 70,0,-15,80,0,0
DATA 10,0,30,50,0,25
DATA 50,0,25,70,0,15
DATA 70,0,15,80,0,0
DATA 80,0,0,77,-5,0
DATA 77,-5,0,65,-10,0
DATA 65,-10,0,45,-15,0
DATA 45,-15,0,10,-20,0
DATA 65,-10,0,57,-10,-10
DATA 57,-10,-10,40,-10,-20
DATA 40,-10,-20,10,-10,-30
DATA 65,-10,0,57,-10,10
DATA 57,-10,10,40,-10,20
DATA 40,-10,20,10,-10,30
DATA 57,-10,10,70,0,15
DATA 40,-10,20,50,0,25
DATA 57,-10,-10,70,0,-15
DATA 40,-10,-20,50,0,-25
'body
DATA 10,0,-30,10,0,30
DATA 10,-20,20,10,-20,-20
DATA 10,0,-30,10,-10,-30
DATA 10,-10,-30,10,-20,-20
DATA 10,0,30,10,-10,30
DATA 10,-10,30,10,-20,20
DATA -40,0,-30,-40,0,30
DATA -40,-20,20,-40,-20,-20
DATA -40,0,-30,-40,-10,-30
DATA -40,-10,-30,-40,-20,-20
DATA -40,0,30,-40,-10,30
DATA -40,-10,30,-40,-20,20
DATA -40,-10,-30,10,-10,-30
DATA -40,-20,-20,10,-20,-20
DATA -40,-10,30,10,-10,30
DATA -40,-20,20,10,-20,20
'tail
DATA -40,-20,-20,-50,-35,-25
DATA -50,-35,-25,-30,-35,-25
DATA -30,-35,-25,0,-20,-20
DATA -40,-20,20,-50,-35,25
DATA -50,-35,25,-30,-35,25
DATA -30,-35,25,0,-20,20
url=http://webberboy.no-ip.com]Fine Hand-Crafted Pens[/url]
Pneumonoultramicroscopicsilicovolcanoconiosis: Noun, A hypothetical, invented disease of the lungs, caused by inhaling mineral or metallic dust, such as silicon and quartzite, over a long period.]
Pneumonoultramicroscopicsilicovolcanoconiosis: Noun, A hypothetical, invented disease of the lungs, caused by inhaling mineral or metallic dust, such as silicon and quartzite, over a long period.]