17 SCREEN 12, 0
27 COLOR 10
37 PALETTE 0, 2
110 '                   SETUP ROUTINE
120 '
130 DIM C(2, 32, 4), CP$(2, 32, 4)
140 DEFINT N
150 KEY OFF: CLS
160 PRINT "EXPERIMENTS IN FOUR DIMENSIONS"; : PRINT TAB(50);
"SETUP ROUTINE"
170 PRINT STRING$(80, "~"): PRINT
180 INPUT "HOW MANY DIMENSIONS (1 - 4)"; ND
190 IF ND >= 1 AND ND <= 4 THEN 210
200 PRINT : PRINT "ENTRY ERROR - TRY AGAIN": PRINT : GOTO 180
210 D$ = " DIMENSIONS"
220 ON ND GOTO 230, 240, 250, 260
230 X$ = "ONE": D$ = " DIMENSION": GOTO 270
240 X$ = "TWO": GOTO 270
250 X$ = "THREE": GOTO 270
260 X$ = "FOUR"
270 MESS$ = "EXPERIMENTS IN " + X$ + D$ + CHR$(10) + STRING$(80,
"~") + CHR$(10)
280 '
1000 '
1010 '                   MAIN MENU
1020 '
1030 CLS : PRINT MESS$: PRINT : PRINT "MAIN MENU:": PRINT
1040 PRINT TAB(7); "1 -- SPECIFY ALL NEW COORDINATES"
1050 PRINT TAB(7); "2 -- DISPLAY CURRENT COORDINATES"
1060 PRINT TAB(7); "3 -- EDIT CURRENT COORDINATES"
1070 PRINT TAB(7); "4 -- TRANSLATE THE COORDINATES"
1080 PRINT TAB(7); "5 -- SCALE THE CORDINATES"
1090 PRINT TAB(7); "6 -- ROTATE THE COORDINATES"
1100 PRINT TAB(7); "7 -- CALCULATE LENGHTS OF LINES"
1110 PRINT TAB(7); "8 -- RESTORE ORIGINAL COORDINATES"
1120 PRINT TAB(7); "9 -- QUIT THE PROGRAM"
1130 PRINT : GOSUB 1300
1140 IF ASC(K$) >= 49 AND ASC(K$) <= 57 THEN 1160
1150 PRINT : PRINT "ENTRY ERROR - TRY AGAIN": GOTO 1130
1160 ON VAL(K$) GOTO 1170, 1180, 1190, 1200, 1210, 1220, 1230,
1240, 1250
1170 T = 1: GOSUB 2000: GOTO 1000
1180 GOSUB 3000: GOSUB 1400: GOTO 1000
1190 GOSUB 4000: GOTO 1000
1200 T = 2: GOSUB 5000: GOTO 1000
1210 T = 2: GOSUB 6000: GOTO 1000
1220 T = 2: GOSUB 7000: GOTO 1000
1230 GOSUB 8000: GOTO 1000
1240 T = 1: GOSUB 9000: GOTO 1000
1250 CLS : KEY ON: END
1300 '
1310 '                   SELECT ONE
1320 '
1330 PRINT : PRINT "SELECT ONE"
1340 GOSUB 1440: RETURN
1350 '
1400 '
1410 '                   STRIKE ANY KEY
1420 '
1430 PRINT "STRIKE ANY KEY TO RETURN TO THE MAIN MENU"
1440 K$ = INKEY$: IF K$ = "" THEN 1440
1450 RETURN
1460 '
2000 '
2010 '                  NEW COORDINATES
2020 '
2030 CLS : PRINT MESS$: PRINT
2040 INPUT "HOW MANY POINTS (1 - 32)"; NP
2050 IF NP >= 1 AND NP <= 32 THEN 2070
2060 PRINT : PRINT "ENTRY ERROR - TRY AGAIN": PRINT : GOTO 2040
2070 CLS : PRINT MESS$: PRINT
2080 PRINT "ENTER YOUR"; NP; "POINT COORDINATE";
2090 IF NP > 1 THEN PRINT "S";
2100 PRINT " AS X";
2110 IF ND > 1 THEN PRINT ",Y";
2120 IF ND > 2 THEN PRINT ",Z";
2130 IF ND > 3 THEN PRINT ",W";
2140 PRINT : PRINT
2150 FOR N = 1 TO NP
2160 PRINT TAB(20); "P"; MID$(STR$(N), 2);
2170 ON ND GOTO 2180, 2190, 2200, 2210
2180 INPUT "=", C(1, N, 1): GOTO 2220
2190 INPUT "=", C(1, N, 1), C(1, N, 2): GOTO 2220
2200 INPUT "=", C(1, N, 1), C(1, N, 2), C(1, N, 3): GOTO 2220
2210 INPUT "=", C(1, N, 1), C(1, N, 2), C(1, N, 3), C(1, N, 4)
2220 FOR X = 1 TO ND: C(2, N, X) = C(1, N, X): NEXT X
2230 NEXT N
2240 GOSUB 3000: GOSUB 1400: GOTO 1000
2250 '
3000 '
3010 '                   PACK AND PRINT COORDINATES
3020 '
3030 CLS : PRINT MESS$: PRINT "SUMMARY OF CURRENT POINTS:": PRINT
3040 FOR N = 1 TO NP
3050 IF POS(X) > 60 THEN PRINT
3060 PRINT "P"; : IF T > 1 THEN PRINT "'";
3070 PRINT MID$(STR$(N), 2); "=(";
3080 FOR X = 1 TO ND
3090 CP$(1, N, X) = STR$(INT(1000 * C(1, N, X)) / 1000)
3100 IF ASC(LEFT$(CP$(1, N, X), 1)) = 32 THEN CP$(1, N, X) =
MID$(CP$(1, N, X), 2)
3110 PRINT CP$(1, N, X); "'";
3120 NEXT X
3130 PRINT CHR$(29) + ")",
3140 NEXT N
3150 PRINT : PRINT : RETURN
3160 '
4000 '
4010 '                    EDIT
4020 '
4030 GOSUB 3000
4040 PRINT : PRINT "WHICH POINT DO YOU WANT TO EDIT?": PRINT
4050 PRINT : INPUT "(STRIKE RETURN TO RETURN TO MAIN MENU) ", PE$
4060 IF PE$ = "" THEN RETURN
4070 IF LEFT$(PE$, 1) = "P" OR LEFT$(PE$, 1) = "p" THEN PE$ =
MID$(PE$, 2)
4080 PE = VAL(PE$)
4090 IF PE >= 1 AND PE <= NP THEN 4110
4100 PRINT : PRINT "ENTRY ERROR - TRY AGAIN": GOTO 4040
4110 PRINT TAB(7); "P"; PE$; "=";
4120 ON ND GOTO 4130, 4140, 4150, 4160
4130 INPUT C(1, PE, 1): GOTO 4170
4140 INPUT C(1, PE, 1), C(1, PE, 2): GOTO 4170
4150 INPUT C(1, PE, 1), C(1, PE, 2), C(1, PE, 3): GOTO 4170
4160 INPUT C(1, PE, 1), C(1, PE, 2), C(1, PE, 3), C(1, PE, 4)
4170 GOTO 4000
4180 '
5000 '
5010 '                   TRANSLATION
5020 '
5030 CLS : PRINT MESS$
5040 PRINT "SPECIFY THE TRANSLATION TERM";
5050 IF ND > 1 THEN PRINT "S";
5060 PRINT ":": PRINT
5070 PRINT TAB(30); : INPUT "TX=", T(1)
5080 IF ND > 1 THEN PRINT TAB(30); : INPUT "TY=", T(2)
5090 IF ND > 2 THEN PRINT TAB(30); : INPUT "TZ=", T(3)
5100 IF ND > 3 THEN PRINT TAB(30); : INPUT "TW=", T(4)
5110 FOR N = 1 TO NP: FOR X = 1 TO ND
5120 C(1, N, X) = C(1, N, X) + T(X)
5130 NEXT X: NEXT N
5140 GOSUB 3000: GOTO 1400: RETURN
5150 '
6000 '
6010 '                   SCALING
6020 '
6030 CLS : PRINT MESS$
6040 PRINT "SPECIFY THE SCALING FACTOR";
6050 IF ND > 1 THEN PRINT "S";
6060 PRINT ":": PRINT
6070 PRINT TAB(30); : INPUT "KX=", T(1)
6080 IF ND > 1 THEN PRINT TAB(30); : INPUT "KY=", T(2)
6090 IF ND > 2 THEN PRINT TAB(30); : INPUT "KZ=", T(3)
6100 IF ND > 3 THEN PRINT TAB(30); : INPUT "KW=", T(4)
6110 FOR N = 1 TO NP: FOR X = 1 TO ND
6120 C(1, N, X) = C(1, N, X) * T(X)
6130 NEXT X: NEXT N
6140 GOSUB 3000: GOTO 1400: RETURN
6150 '
7000 '
7010 '                   ROTATION
7020 '
7030 CLS : PRINT MESS$: PRINT
7040 IF ND > 1 THEN 7070
7050 PRINT "YOU CANNOT ROTATE IN JUST ONE DIMENSION."
7060 GOSUB 1400: RETURN
7070 INPUT "SPECIFY ANY ANGLE OF ROTATION (DEGREES): "; ANG
7080 RAD = ANG * (3.141593 / 180)
7090 ON ND - 1 GOTO 7100, 7110, 7220
7100 T(1) = 1: T(2) = 2: GOTO 7390
7110 CLS : PRINT MESS$: PRINT
7120 PRINT "AXES OF ROTATION:": PRINT
7130 PRINT TAB(7); "1 -- X AXIS"
7140 PRINT TAB(7); "2 -- Y AXIS"
7150 PRINT TAB(7); "3 -- Z AXIS"
7160 GOSUB 1300
7170 IF ASC(K$) < 49 OR ASC(K$) > 51 THEN GOSUB 1440: GOTO 7170
7180 ON VAL(K$) GOTO 7190, 7200, 7210
7190 T(1) = 2: T(2) = 3: GOTO 7390
7200 T(1) = 1: T(2) = 3: GOTO 7390
7210 T(1) = 1: T(2) = 2: GOTO 7390
7220 CLS : PRINT MESS$: PRINT
7230 PRINT "PLANES OF ROTATION:": PRINT
7240 PRINT TAB(7); "1 -- X-Y PLANE"
7250 PRINT TAB(7); "2 -- X-Z PLANE"
7260 PRINT TAB(7); "3 -- X-W PLANE"
7270 PRINT TAB(7); "4 -- Y-Z PLANE"
7280 PRINT TAB(7); "5 -- Y-W PLANE"
7290 PRINT TAB(7); "6 -- Z-W PLANE"
7300 GOSUB 1300
7310 IF ASC(K$) < 49 OR ASC(K$) > 54 THEN GOSUB 1440: GOTO 7310
7320 ON VAL(K$) GOTO 7330, 7340, 7350, 7360, 7370, 7380
7330 T(1) = 3: T(2) = 4: GOTO 7390
7340 T(1) = 2: T(2) = 4: GOTO 7390
7350 T(1) = 2: T(2) = 3: GOTO 7390
7360 T(1) = 1: T(2) = 4: GOTO 7390
7370 T(1) = 1: T(2) = 3: GOTO 7390
7380 T(1) = 1: T(2) = 2
7390 PRINT : PRINT "OK"
7400 FOR N = 1 TO NP
7410 R1 = C(1, N, T(1)) * COS(RAD) - C(1, N, T(2)) * SIN(RAD)
7420 R2 = C(1, N, T(1)) * SIN(RAD) + C(1, N, T(2)) * COS(RAD)
7430 C(1, N, T(1)) = R1: C(1, N, T(2)) = R2
7440 NEXT N
7450 GOSUB 3000: GOSUB 1400: RETURN
8000 '
8010 '                   LENGTH
8020 '
8030 GOSUB 3000
8040 PRINT : INPUT "SPECIFY ONE OF THE ENDPOINTS: P", E1
8050 IF E1 >= 1 AND E1 <= NP THEN 8070
8060 PRINT : PRINT "ENTRY ERROR - TRY AGAIN": GOTO 8040
8070 INPUT "SPECIFY THE SECOND ENDPOINT: P", E2
8080 IF E2 >= 1 AND E2 <= NP THEN 8100
8090 PRINT : PRINT "ENTRY ERROR - TRY AGAIN": GOTO 8070
8100 CLS : PRINT MESS$: PRINT
8110 PRINT "THE LENGTH OF A LINE BETWEEN POINTS P";
8120 PRINT MID$(STR$(E1), 2); " AND P";
8130 PRINT MID$(STR$(E2), 2); " IS: ";
8140 T(0) = 0
8150 FOR X = 1 TO ND
8160 D(X) = C(1, E2, X) - C(1, E1, X)
8170 T(0) = T(0) + D(X) ^ 2
8180 NEXT X
8190 T(0) = SQR(T(0)): PRINT INT(1000 * T(0)) / 1000
8200 PRINT : PRINT "THE DIRECTION COSINE";
8210 IF ND > 1 THEN PRINT "S";
8220 PRINT " FOR THAT LINE";
8230 IF ND > 1 THEN PRINT " ARE:";  ELSE PRINT " IS:";
8240 PRINT : PRINT
8250 PRINT TAB(35); "A="; INT(1000 * D(1) / T(0)) / 1000
8260 IF ND > 1 THEN PRINT TAB(35); "B="; INT(1000 * D(2) / T(0))
/ 1000
8270 IF ND > 2 THEN PRINT TAB(35); "C="; INT(1000 * D(3) / T(0))
/ 1000
8280 IF ND > 3 THEN PRINT TAB(35); "D="; INT(1000 * D(4) / T(0))
/ 1000
8290 PRINT : PRINT : PRINT "DO YOU WANT TO FIND ANOTHER LENGTH
(Y/N)?"
8300 GOSUB 1440
8310 IF K$ = "Y" OR K$ = "y" THEN 8000
8320 IF K$ = "N" OR K$ = "n" THEN RETURN
8330 GOTO 8300
9000 '
9010 '                   RESTORE
9020 '
9030 PRINT : PRINT "OK"
9040 FOR N = 1 TO NP: FOR X = 1 TO ND
9050 C(1, N, X) = C(2, N, X)
9060 NEXT X: NEXT N
9070 GOSUB 3000: GOSUB 1400
9080 RETURN