'=========================================================================== ' Subject: BOUNCING LINES IN 3D BOX Date: 04-11-96 (13:51) ' Author: Stephan Doughty Code: QB, QBasic, PDS ' Origin: hbj@pop.ntplx.net Packet: EGAVGA.ABC '=========================================================================== 'This program is the first I have writen in 15 years. This explains the archaic 'code used. You may play with it any way you please. I will try to explain it 'with REM statements. It is a try at displaying three dots (xyz axis) and bouncing 'them around a three-D cube. I have also tried to implement a kind of gravity 'factor for each dot (- or +). the palette is played with also. And an attempt at 'making the lines "fade" as they grow "old". Have fun, Stephen Doughty 'To contact me please use email address, hbj@ntplx.net (its a work address) 10 REM BOWBOX.BAS 'program name 20 K = 6 * 4: S = 6: I = 1 'K must be a multiple of 6 to work properly 30 RANDOMIZE TIMER: SCREEN 12 'sets SCREEN and RND 40 DEF FNR = RND * 4 + 4 'determines line spacing 50 DEF FNZ = INT((RND * 2) + 1) * 2 - 3 'Picks a number (-1 or 1) 60 DIM X(K): DIM Y(K): DIM Z(K): DIM A(K): DIM B(K): DIM C(K) 'XYZ ABC PQR are for holding line cordinates 70 DIM P(K): DIM Q(K): DIM R(K): DIM H(S) 'H is for line redraw for fading lines 80 FOR H = 1 TO 6: H(H) = K * (S - H) / S: NEXT H 'sets up line spacing using K 86 FOR S = 1 TO 13 STEP 3 'Loads palettes for each line 88 PALETTE S, (S + 3) * 4 - 1 'Red 90 PALETTE S + 1, (S + 2) * 4 + (S + 2) * 4 * 256 'Green 92 PALETTE S + 2, (S + 1) * 4 * 65536 'Blue 96 NEXT S 100 X = RND * 300 + 1: XB = FNR * FNZ 'Picks line coordinates for 110 Y = RND * 300 + 1: YB = FNR * FNZ 'XYZ ABC PQR and there movement factor 120 Z = RND * 300 + 1: ZB = FNR * FNZ 130 A = RND * 300 + 1: AB = FNR * FNZ 140 B = RND * 300 + 1: BB = FNR * FNZ 150 C = RND * 300 + 1: CB = FNR * FNZ 160 P = RND * 300 + 1: PB = FNR * FNZ 170 Q = RND * 300 + 1: QB = FNR * FNZ 180 R = RND * 300 + 1: RB = FNR * FNZ 190 G1 = FNZ: G2 = FNZ: G3 = FNZ 'Initializes Gravity for each dot (- or +) 210 M1 = X - A: N1 = Y - B: O1 = Z - C '210 to 260 set variables for gravity routine 220 M2 = X - P: N2 = Y - Q: O2 = Z - R 230 M3 = A - P: N3 = B - Q: O3 = A - R 240 XYZ = SQR(M1 * M1 + N1 * N1 + O1 * O1) 250 ABC = SQR(M2 * M2 + N2 * N2 + O2 * O2) 260 PQR = SQR(M3 * M3 + N3 * N3 + O3 * O3) 270 IF XYZ < 10 THEN G1 = -G1: G2 = -G2 'If dots are to close together then change gravity 280 IF ABC < 10 THEN G1 = -G1: G3 = -G3 290 IF PQR < 10 THEN G2 = -G2: G3 = -G3 300 XB = XB - G1 * (M1 + M2) / (XYZ + ABC) ' Gravity routine (I think) 310 YB = YB - G1 * (N1 + N2) / (XYZ + ABC) ' May not be correct 320 ZB = ZB - G1 * (O1 + O2) / (XYZ + ABC) 330 AB = AB - G2 * (M1 + M3) / (XYZ + PQR) 340 BB = BB - G2 * (N1 + N3) / (XYZ + PQR) 350 CB = CB - G2 * (O1 + O3) / (XYZ + PQR) 360 PB = PB - G3 * (M2 + M3) / (ABC + PQR) 370 QB = QB - G3 * (N2 + N3) / (ABC + PQR) 380 RB = RB - G3 * (O2 + O3) / (ABC + PQR) 390 IF X + XB < 0 OR X + XB > 300 THEN XB = -SGN(XB) * FNR: G1 = -G1 'Checks for out-of-bounds 400 IF Y + YB < 0 OR Y + YB > 300 THEN YB = -SGN(YB) * FNR: G1 = -G1 'if so, it changes movement factor 410 IF Z + ZB < 0 OR Z + ZB > 300 THEN ZB = -SGN(ZB) * FNR: G1 = -G1 'and gravity 420 IF A + AB < 0 OR A + AB > 300 THEN AB = -SGN(AB) * FNR: G2 = -G2 430 IF B + BB < 0 OR B + BB > 300 THEN BB = -SGN(BB) * FNR: G2 = -G2 440 IF C + CB < 0 OR C + CB > 300 THEN CB = -SGN(CB) * FNR: G2 = -G2 450 IF P + PB < 0 OR P + PB > 300 THEN PB = -SGN(PB) * FNR: G3 = -G3 460 IF Q + QB < 0 OR Q + QB > 300 THEN QB = -SGN(QB) * FNR: G3 = -G3 470 IF R + RB < 0 OR R + RB > 300 THEN RB = -SGN(RB) * FNR: G3 = -G3 480 X = X + XB: Y = Y + YB: Z = Z + ZB 'Adds line and movement factor together 490 A = A + AB: B = B + BB: C = C + CB 500 P = P + PB: Q = Q + QB: R = R + RB 510 X(I) = X: Y(I) = Y: Z(I) = Z 'Remembers lines in array 520 A(I) = A: B(I) = B: C(I) = C 'for fade routine and 530 P(I) = P: Q(I) = Q: R(I) = R 'erase 540 I = I + 1 + ((I = K) * K) 'Cycles line by adding one, if >K then (1) again 545 GOSUB 1000: S = 16 'Gosub 1000 refreshes cube. S is palette information 550 FOR H = 1 TO 6 560 J = I + H(H) + (I + H(H) > K) * K 'Which line fades next 565 S = S - 1 580 LINE (X(J) + Z(J) / 2, Y(J) + Z(J) / 2)-(A(J) + C(J) / 2, B(J) + C(J) / 2), S 585 S = S - 1 - (S = 0) 590 LINE (A(J) + C(J) / 2, B(J) + C(J) / 2)-(P(J) + R(J) / 2, Q(J) + R(J) / 2), S 595 S = S - 1 - (S = 0) 600 LINE (P(J) + R(J) / 2, Q(J) + R(J) / 2)-(X(J) + Z(J) / 2, Y(J) + Z(J) / 2), S 610 NEXT H 620 IF INKEY$ <> "" THEN END ELSE 210 'if any key then stop 1000 COLOR 7 'Subroutine for cube 1010 LINE (0, 0)-(300, 300), , B 1050 LINE (150, 150)-(450, 450), , B 1090 LINE (0, 0)-(150, 150) 1100 LINE (0, 300)-(150, 450) 1110 LINE (300, 300)-(450, 450) 1120 LINE (300, 0)-(450, 150) 1130 RETURN