Nibble Magazine/nib14.dsk/ORACLE.bas

BASIC Source File | 2023-02-26 | 23KB | 844 lines

10  REM ************************
20  REM *                      *
30  REM *  THE ORACLE          *
40  REM *  BY JEFF G. COX      *
50  REM *  COPYRIGHT (C) 1983  *
60  REM *  BY MICROSPARC, INC. *
70  REM *  LINCOLN, MA. 01773  *
80  REM *                      *
90  REM ************************
100  GOTO 6700
110  REM * UTILITIY ROUTINES ****
120  REM * UPDATE ALT. RESULTS *
130  GOSUB 5440: PRINT "*** UPDATING SCORES ***"
140  IF PSUM% < >0  THEN 160
150 VLOC% = 2: FOR J = 1 TO ANUM%:ARES(J) = 0.0:VLOC% = VLOC% +1:NUMB = ARES(J): GOSUB 180: NEXT : RETURN
160  FOR J = 1 TO ANUM%:GSUM(J) = 0: NEXT : FOR J = 1 TO FACT%: FOR K = 1 TO ANUM%:GSUM(K) = GSUM(K) +PDES%(J) *GDES%(K,J): NEXT : NEXT :VLOC% = 2: FOR J = 1 TO ANUM%:ARES(J) = GSUM(J)/PSUM%:VLOC% = VLOC% +1:NUMB = ARES(J): GOSUB 180: NEXT : RETURN
170  REM * PRINT A REAL *******
180 A =  INT(NUMB) + INT((NUMB - INT(NUMB)) *10 +0.5)/10:A% = 8: IF A =  INT(NUMB)  OR A -1 =  INT(NUMB)  THEN A% = 6
190  IF PAGE% = 0  THEN  VTAB VLOC%: HTAB 2
200  PRINT  TAB( A% - LEN( STR$(A)));A;
210  IF A% = 6  THEN  PRINT ".0";
220  RETURN
230  REM * PRINT A NAME ***
240  HTAB 10: PRINT INPT$;
250  IF PAGE% < >0  THEN  PRINT
260  RETURN
270  REM * CLEAR WINDOW ***
280  IF WNDW% <0  OR WNDW% >4  THEN  RETURN
290  IF WNDW% = 0  THEN 390
300  ON WNDW% GOTO 310,330,350,370
310 VFIR% = 1:VBOT% = 24
320  GOTO 390
330 VFIR% = 1:VBOT% = 8
340  GOTO 390
350 VFIR% = 9:VBOT% = 20
360  GOTO 390
370 VFIR% = 21:VBOT% = 24
380  GOTO 390
390  VTAB VFIR%
400  POKE 34,VFIR% -1
410  POKE 35,VBOT%
420  HOME
430  RETURN
440  REM * DISP ALT. & RESULTS *
450  IF PAGE% < >0  THEN 480
460 WNDW% = 2: GOSUB 280
470 VLOC% = VFIR% +1
480  PRINT "ANALYSIS:  ";NAME$
490  PRINT " RESULT  ALTERNATIVE"
500  IF ANUM% <1  THEN  RETURN
510  FOR J = 1 TO ANUM%
520 NUMB = ARES(J)
530 VLOC% = VLOC% +1
540  GOSUB 180
550 INPT$ = ADES$(J): GOSUB 240
560  NEXT
570  RETURN
580  REM * DISP FACTORS & PRIORITIES
590  IF PAGE% < >0  THEN 620
600 WNDW% = 3: GOSUB 280
610 VLOC% = VFIR% +1
620  PRINT
630  PRINT "PRIORITY FACTOR"
640  IF FACT% <1  THEN  RETURN
650 A% = FCUR% +FLNG% -1: IF A% >FACT%  THEN A% = FACT%
660  FOR J = FCUR% TO A%
670 NUMB = PDES%(J)
680 VLOC% = VLOC% +1
690  GOSUB 180
700 INPT$ = FDES$(J): GOSUB 240
710  NEXT
720  RETURN
730  REM * DISP FACS & GRADES *
740 WNDW% = 3: GOSUB 280
750 VLOC% = VFIR% +1
760  PRINT "ALTERNATIVE: ";ADES$(ACUR%)
770  PRINT "  GRADE  FACTOR"
780  IF FACT% <1  THEN  RETURN
790 A% = FCUR% +FLNG% -1: IF A% >FACT%  THEN A% = FACT%
800  FOR J = FCUR% TO A%
810 NUMB = GDES%(ACUR%,J)
820 VLOC% = VLOC% +1
830  GOSUB 180
840 INPT$ = FDES$(J): GOSUB 240
850  NEXT
860  RETURN
870  REM * DISP ALT. & GRADES *
880  IF PAGE% < >0  THEN 910
890 WNDW% = 3: GOSUB 280
900 VLOC% = VFIR% +1
910  PRINT "FACTOR: ";FDES$(FCUR%)
920  PRINT "  GRADE  ALTERNATIVE"
930 A% = ACUR% +ALNG% -1: IF A% >ANUM%  THEN A% = ANUM%
940  FOR J = ACUR% TO A%
950 NUMB = GDES%(J,FCUR%)
960 VLOC% = VLOC% +1
970  GOSUB 180
980 INPT$ = ADES$(J): GOSUB 240
990  NEXT
1000  RETURN
1010  REM * GET A NAME ***
1020  POKE 51,191
1030 INPT$ = ""
1040  CALL  -662
1050  FOR J = 512 TO 767
1060 A% =  PEEK(J) -128
1070  IF A% = 13  THEN 1100
1080 INPT$ = INPT$ + CHR$(A%)
1090  NEXT
1100  IF  LEN(INPT$) = 0  THEN INPT$ = ALPH$
1110 ALPH$ =  LEFT$(INPT$,WLNG%)
1120  RETURN
1130  REM * SELECT FILE NAME ***
1140 WNDW% = 4: GOSUB 280
1150  PRINT A$
1160  PRINT "ENTER ANALYSIS NAME ('C' FOR CATALOG;": PRINT "'M' FOR MENU;"
1170  PRINT "  <RETURN> FOR ";NAME$;")";"   ";
1180 ALPH$ = NAME$
1190  GOSUB 1020
1200  IF ALPH$ < >"C"  THEN 1250
1210 WNDW% = 1: GOSUB 280
1220  PRINT CD$;"CATALOG"
1230  GOSUB 5510
1240  GOTO 1140
1250 NAME$ = ALPH$: IF ALPH$ = "M"  THEN  CALL  -10621: HOME : GOTO 6820
1260 WNDW% = 1: GOSUB 280
1270  RETURN
1280  REM * WRITE DATA BASE **
1290  IF SFLG% < >1  THEN  RETURN
1300 A$ = "SAVE ANALYSIS TO DISC -"
1310  GOSUB 5690
1320  IF INPT% < >1  THEN  RETURN
1330 A$ = "TO SAVE ANALYSIS,"
1340  GOSUB 1140
1350  GOSUB 5440
1360  PRINT "*** SAVING ";NAME$;" ***"
1370  PRINT CD$;"OPEN ";NAME$
1380  PRINT CD$;"WRITE ";NAME$
1390  PRINT ANUM%;",";FACT%;",";PHI%;",";PLOW%;",";GHI%;",";GLOW%
1400  FOR J = 1 TO ANUM%
1410  PRINT ADES$(J)
1420  PRINT ARES(J)
1430  NEXT
1440  FOR J = 1 TO FACT%
1450  PRINT FDES$(J)
1460  PRINT PDES%(J)
1470  NEXT
1480  FOR J = 1 TO ANUM%
1490  FOR K = 1 TO FACT%
1500  PRINT GDES%(J,K)
1510  NEXT
1520  NEXT
1530  PRINT CD$;"CLOSE ";NAME$
1540  PRINT CD$;"LOCK ";NAME$
1550 SFLG% = 0
1560 WNDW% = 4: GOSUB 280
1570  RETURN
1580  REM * READ DATA BASE
1590 WNDW% = 1: GOSUB 280
1600  GOSUB 1290
1610 WNDW% = 4: GOSUB 280
1620 A$ = "TO RETRIEVE ANALYSIS FROM DISC,"
1630  GOSUB 1140
1640  GOSUB 5440
1650  PRINT "*** RETRIEVING ";NAME$;" ***"
1660 PSUM% = 0
1670  PRINT CD$;"UNLOCK ";NAME$
1680  PRINT CD$;"OPEN ";NAME$
1690  GOSUB 5440
1700  PRINT "*** RETRIEVING ";NAME$;" ***"
1710  PRINT CD$;"READ ";NAME$
1720  INPUT ANUM%,FACT%,PHI%,PLOW%,GHI%,GLOW%
1730  FOR J = 1 TO ANUM%
1740 ADES$(J) = ""
1750  GET INPT$
1760  IF INPT$ = RET$  THEN 1790
1770 ADES$(J) = ADES$(J) +INPT$
1780  GOTO 1750
1790  INPUT ARES(J)
1800  NEXT
1810  FOR J = 1 TO FACT%
1820 FDES$(J) = ""
1830  GET INPT$
1840  IF INPT$ = RET$  THEN 1870
1850 FDES$(J) = FDES$(J) +INPT$
1860  GOTO 1830
1870  INPUT PDES%(J)
1880 PSUM% = PSUM% +PDES%(J)
1890  NEXT
1900  FOR J = 1 TO ANUM%
1910  FOR K = 1 TO FACT%
1920  INPUT GDES%(J,K)
1930  NEXT
1940  NEXT
1950  PRINT  CHR$(1): REM * NOMON FIX
1960  PRINT RET$;CD$;"CLOSE ";NAME$: REM *NOMONFIX
1970  PRINT CD$;"LOCK ";NAME$
1980 WNDW% = 4: GOSUB 280
1990  GOSUB 450
2000  RETURN
2010  REM * CHANGE A NAME *
2020 WNDW% = 4: GOSUB 280
2030  PRINT A$
2040  PRINT "PRESS <RETURN> FOR "
2050  PRINT ALPH$
2060  PRINT "OR ENTER NEW NAME.";
2070  VTAB VLOC%: HTAB 10
2080  PRINT " "; SPC( 27);" ";: HTAB 9
2090  GOSUB 1020
2100  VTAB VLOC%: HTAB 9: PRINT " ";ALPH$
2110 SFLG% = 1
2120  RETURN
2130  REM * CHANGE A VALUE *
2140  IF MFLG% < >1  THEN 2200
2150 WNDW% = 4: GOSUB 280
2160  PRINT A$
2170  PRINT "  CHANGE VALUE (ARROW KEYS TO START,"
2180  PRINT "  ANY OTHER KEY TO STOP), MOVE TO NEXT"
2190  PRINT "  VALUE <SPACE KEY>, OR FINISH <RETURN>";
2200  VTAB VLOC%: HTAB 1
2210  FLASH : PRINT " ";: NORMAL
2220 SPD% = 0:CFLG% = 0
2230 INPT% =  PEEK( -16384) -128: POKE  -16368,0
2240  IF INPT% <0  THEN 2330
2250  IF INPT% = EXEC%  THEN 2390
2260  IF INPT% = SKIP%  THEN 2400
2270 SFLG% = 1
2280 A% = 0
2290  IF INPT% = ICR%  AND SPD% > -1  THEN A% = 1
2300  IF INPT% = DEC%  AND SPD% <1  THEN A% =  -1
2310 SPD% = SPD% +A%
2320  IF A% = 0  THEN SPD% = 0
2330  IF NUMB +SPD% >HI%  THEN SPD% = HI% -NUMB
2340  IF NUMB +SPD% <LOW%  THEN SPD% = LOW% -NUMB
2350 NUMB = NUMB +SPD%
2360  GOSUB 180
2370 A% = 250: GOSUB 5490
2380  GOTO 2230
2390 CFLG% = 1
2400  VTAB VLOC%: HTAB 1: PRINT " "
2410  RETURN
2420  REM * SET ALT.'S GRADES *
2430  IF FACT% <1  THEN  RETURN
2440 MFLG% = 1:A$ = "TO RANK THIS ALTERNATIVE,"
2450 FCUR% = 1
2460 VFIR% = 9
2470  GOSUB 740
2480 VLOC% = VFIR% +1
2490 NUMB = GDES%(ACUR%,FCUR%)
2500 VLOC% = VLOC% +1
2510 HI% = GHI%
2520 LOW% = GLOW%
2530  GOSUB 2140
2540 MFLG% = 0
2550 GDES%(ACUR%,FCUR%) = NUMB
2560  IF CFLG% = 1  THEN 2610
2570 FCUR% = FCUR% +1
2580  IF FCUR% >FACT%  THEN 2450
2590  IF VLOC% >19  THEN 2460
2600  GOTO 2490
2610  GOSUB 130
2620  RETURN
2630  REM * ADD ALTERNATIVE *
2640 WNDW% = 3: GOSUB 280
2650 WNDW% = 4: GOSUB 280
2660  IF ANUM% <AMAX%  THEN 2720
2670 A% = 2: GOSUB 5550
2680  PRINT "I'M SORRY, BUT YOU CANNOT HAVE MORE"
2690  PRINT "  THAN ";AMAX%;" ALTERNATIVES."
2700  GOSUB 5510
2710  RETURN
2720 ANUM% = ANUM% +1
2730 VLOC% = 2 +ANUM%
2740 ALPH$ = "ALTERNATIVE #" + STR$(ANUM%)
2750 A$ = "TO SET THE NEW ALTERNATIVE'S NAME,"
2760  GOSUB 2020
2770 ADES$(ANUM%) = ALPH$
2780  IF FACT% <1  THEN  RETURN
2790 ACUR% = ANUM%
2800 A% = (GHI% +GLOW%)/2
2810  FOR J = 1 TO FACT%
2820 GDES%(ACUR%,J) = A%
2830  NEXT
2840  GOSUB 2430
2850  RETURN
2860  REM * DELETE ALT. *
2870  IF ANUM% >2  THEN 2940
2880 WNDW% = 4: GOSUB 280
2890 A% = 2: GOSUB 5550
2900  PRINT "I'M SORRY, BUT YOU CANNOT HAVE LESS"
2910  PRINT "  THAN 2 ALTERNATIVES."
2920  GOSUB 5510
2930  RETURN
2940 A$ = "TO CHOOSE ALTERNATIVE TO BE DELETED,": GOSUB 5600
2950  IF ACUR% <1  THEN  RETURN
2960 WNDW% = 4: GOSUB 280
2970 A$ = "DELETE " +ADES$(ACUR%) +" - "
2980 VLOC% = VFIR% +1
2990  GOSUB 5690
3000  IF INPT% < >1  THEN  RETURN
3010  GOSUB 5440
3020  IF ACUR% = ANUM%  THEN 3100
3030  FOR J = ACUR% TO ANUM% -1
3040 ADES$(J) = ADES$(J +1)
3050 ARES(J) = ARES(J +1)
3060  FOR K = 1 TO FACT%
3070 GDES%(J,K) = GDES%(J +1,K)
3080  NEXT
3090  NEXT
3100 ANUM% = ANUM% -1
3110  GOSUB 450
3120  RETURN
3130  REM * CHANGE ALT. NAME *
3140 A$ = "TO CHANGE ALTERNATIVE'S NAME,": GOSUB 5600
3150  IF ACUR% <1  THEN  RETURN
3160 ALPH$ = ADES$(ACUR%)
3170 VLOC% = 2 +ACUR%
3180  GOSUB 2020
3190 ADES$(ACUR%) = ALPH$
3200  RETURN
3210  REM * SET FACTOR'S GRADES *
3220 MFLG% = 1:A$ = "TO RANK ALTERNATIVES FOR THIS FACTOR,"
3230 ACUR% = 1
3240  GOSUB 880
3250 VLOC% = VFIR% +1
3260 NUMB = GDES%(ACUR%,FCUR%)
3270 VLOC% = VLOC% +1
3280 HI% = GHI%
3290 LOW% = GLOW%
3300  GOSUB 2140
3310 MFLG% = 0
3320 GDES%(ACUR%,FCUR%) = NUMB
3330  IF CFLG% = 1  THEN 3370
3340 ACUR% = ACUR% +1
3350  IF ACUR% >ANUM%  THEN 3230
3360  GOTO 3260
3370  GOSUB 130
3380  RETURN
3390  REM * ADD FACTOR *
3400 WNDW% = 4: GOSUB 280
3410  IF FACT% <FMAX%  THEN 3470
3420 A% = 2: GOSUB 5550
3430  PRINT "I'M SORRY, BUT YOU CANNOT HAVE MORE"
3440  PRINT "  THAN ";FMAX%;" FACTORS."
3450  GOSUB 5510
3460  RETURN
3470 FCUR% = 1
3480  IF FACT% +1 >FCUR% +FLNG% -1  THEN FCUR% = FCUR% +FLNG%
3490  GOSUB 590
3500 FACT% = FACT% +1
3510 VLOC% = VFIR% +2 +FACT% -FCUR%
3520 ALPH$ = "FACTOR #" + STR$(FACT%)
3530 A$ = "TO SET THE NEW FACTOR'S NAME,"
3540  GOSUB 2020
3550 FDES$(FACT%) = ALPH$
3560 PDES%(FACT%) = (PHI% +PLOW%)/2
3570 HI% = PHI%:LOW% = PLOW%
3580 NUMB = PDES%(FACT%)
3590 MFLG% = 1:A$ = "TO SET FACTOR'S PRIORITY,"
3600  GOSUB 2140
3610 PDES%(FACT%) = NUMB
3620 PSUM% = PSUM% +PDES%(FACT%)
3630  IF ANUM% <1  THEN  RETURN
3640 FCUR% = FACT%
3650 A% = (GHI% +GLOW%)/2
3660  FOR J = 1 TO ANUM%
3670 GDES%(J,FCUR%) = A%
3680  NEXT
3690  GOSUB 3220
3700  RETURN
3710  REM * DELETE A FACTOR *
3720 WNDW% = 4: GOSUB 280
3730  IF FACT% >1  THEN 3790
3740 A% = 2: GOSUB 5550
3750  PRINT "I'M SORRY, BUT YOU CANNOT HAVE LESS"
3760  PRINT "  THAN 1 FACTOR."
3770  GOSUB 5510
3780  RETURN
3790 A$ = "TO DELETE A FACTOR,": GOSUB 5850
3800  IF FCUR% <1  THEN  RETURN
3810 A$ = "DELETE " +FDES$(FCUR%) +" - "
3820  GOSUB 5690
3830  IF INPT% < >1  THEN  RETURN
3840 PSUM% = PSUM% -PDES%(FCUR%)
3850  IF FCUR% = FACT%  THEN 3930
3860  FOR J = FCUR% TO FACT% -1
3870 FDES$(J) = FDES$(J +1)
3880 PDES%(J) = PDES%(J +1)
3890  FOR K = 1 TO ANUM%
3900 GDES%(K,J) = GDES%(K,J +1)
3910  NEXT
3920  NEXT
3930 FACT% = FACT% -1
3940  GOSUB 130
3950  RETURN
3960  REM * CHANGE PRIORITY *
3970  IF FACT% <1  THEN  RETURN
3980 MFLG% = 1:A$ = "TO CHANGE A FACTOR'S PRIORITY,"
3990 FCUR% = 1
4000 VFIR% = 9
4010  GOSUB 590
4020 VLOC% = VFIR% +1
4030 NUMB = PDES%(FCUR%)
4040 HI% = PHI%:LOW% = PLOW%
4050 VLOC% = VLOC% +1
4060  GOSUB 2140
4070 MFLG% = 0
4080 PSUM% = PSUM% -PDES%(FCUR%) +NUMB
4090 PDES%(FCUR%) = NUMB
4100  IF CFLG% = 1  THEN 4150
4110 FCUR% = FCUR% +1
4120  IF FCUR% >FACT%  THEN 3990
4130  IF VLOC% >19  THEN 4000
4140  GOTO 4030
4150  GOSUB 130
4160  RETURN
4170  REM * CHANGE FACT NAME *
4180 A$ = "TO CHANGE A FACTOR'S NAME,": GOSUB 5850
4190  IF FCUR% <1  THEN  RETURN
4200 ALPH$ = FDES$(FCUR%)
4210 VLOC% = 10 +FCUR%
4220  IF VLOC% >19  THEN VLOC% = VLOC% -FLNG%
4230  GOSUB 2020
4240 FDES$(FCUR%) = ALPH$
4250  RETURN
4260  REM * INITIALIZE DATA BASE *
4270 WNDW% = 1: GOSUB 280
4280  GOSUB 1290
4290 NAME$ = "TRADE STUDY"
4300 A$ = "TO START A NEW ANALYSIS,"
4310  GOSUB 1140
4320 WNDW% = 1: GOSUB 280
4330  PRINT "ANALYSIS:  ";NAME$
4340  PRINT "  VALUE  PARAMETERS"
4350 AHI% = 2
4360 FHI% = 1
4370 PHI% = 100
4380 PLOW% = 1
4390 GHI% = 100
4400 GLOW% = 1
4410 AFLG% = 0
4420 NUMB = AHI%:VLOC% = 3: GOSUB 180
4430  PRINT "  NUMBER OF ALTERNATIVES"
4440 NUMB = FHI%:VLOC% = 4: GOSUB 180
4450  PRINT "  NUMBER OF FACTORS"
4460 NUMB = PHI%:VLOC% = 5: GOSUB 180
4470  PRINT "  HIGHEST FACTOR PRIORITY"
4480 NUMB = PLOW%:VLOC% = 6: GOSUB 180
4490  PRINT "  LOWEST FACTOR PRIORITY"
4500 NUMB = GHI%:VLOC% = 7: GOSUB 180
4510  PRINT "  HIGHEST POSSIBLE SCORE"
4520 NUMB = GLOW%:VLOC% = 8: GOSUB 180
4530  PRINT "  LOWEST POSSIBLE SCORE"
4540 NUMB = AFLG%:VLOC% = 9: GOSUB 180
4550  PRINT "  SET ALTERNATIVES FIRST (0)"
4560  PRINT  SPC( 7);"    OR FACTORS FIRST (1)";
4570 MFLG% = 1:A$ = "TO CHANGE A PARAMETER,"
4580 VLOC% = 3
4590 NUMB = AHI%:HI% = AMAX%:LOW% = 2
4600  GOSUB 2140
4610 AHI% = NUMB
4620 MFLG% = 0
4630  IF CFLG% = 1  THEN 4990
4640 VLOC% = VLOC% +1
4650 NUMB = FHI%:HI% = FMAX%:LOW% = 1
4660  GOSUB 2140
4670 FHI% = NUMB
4680  IF CFLG% = 1  THEN 4990
4690 VLOC% = VLOC% +1
4700 NUMB = PHI%:HI% = 100:LOW% = PLOW% +1
4710  GOSUB 2140
4720 PHI% = NUMB
4730  IF CFLG% = 1  THEN 4990
4740 VLOC% = VLOC% +1
4750 NUMB = PLOW%:HI% = PHI% -1:LOW% = 1
4760  GOSUB 2140
4770 PLOW% = NUMB
4780  IF CFLG% = 1  THEN 4990
4790 VLOC% = VLOC% +1
4800 NUMB = GHI%:HI% = 100:LOW% = GLOW% +1
4810  GOSUB 2140
4820 GHI% = NUMB
4830  IF CFLG% = 1  THEN 4990
4840 VLOC% = VLOC% +1
4850 NUMB = GLOW%:HI% = GHI% -1:LOW% = 1
4860  GOSUB 2140
4870 GLOW% = NUMB
4880  IF CFLG% = 1  THEN 4990
4890 VLOC% = VLOC% +1
4900 NUMB = AFLG%:HI% = 1:LOW% = 0
4910  GOSUB 2140
4920 AFLG% = NUMB
4930  IF CFLG% = 1  THEN 4990
4940  GOTO 4570
4950 SFLG% = 1
4960 WNDW% = 1: GOSUB 280
4970  GOSUB 450
4980  GOSUB 130
4990 WNDW% = 1: GOSUB 280
5000 FACT% = 0:ANUM% = 0:PSUM% = 0
5010  IF AFLG% < >1  THEN 5100
5020  FOR J1 = 1 TO FHI%
5030  GOSUB 3400
5040  NEXT
5050  GOSUB 450
5060  FOR J1 = 1 TO AHI%
5070  GOSUB 2640
5080  NEXT
5090  GOTO 5170
5100  GOSUB 450
5110  FOR J1 = 1 TO AHI%
5120  GOSUB 2640
5130  NEXT
5140  FOR J1 = 1 TO FHI%
5150  GOSUB 3400
5160  NEXT
5170  RETURN
5180  REM * HANDLE MENU *
5190 WNDW% = 4: GOSUB 280
5200  PRINT A$
5210  PRINT "  MOVE TO NEXT ITEM <SPACE BAR>,"
5220  PRINT "  SELECT ITEM <RETURN>, OR EXIT <ESC>.";
5230 VCUR% = M1%
5240  VTAB VCUR%
5250  HTAB 2
5260  FLASH : PRINT " ";: NORMAL
5270  GOSUB 5800
5280  IF INPT% = CNCL%  THEN INPT% = 0: GOTO 5390
5290  IF INPT% = EXEC%  THEN INPT% = VCUR% -M1% +1: GOTO 5390
5300  IF INPT% = SKIP%  THEN 5330
5310 A% = 1: GOSUB 5550
5320  GOTO 5270
5330  VTAB VCUR%: HTAB 2
5340  PRINT " ";
5350 VCUR% = VCUR% +1
5360  IF VCUR% < = M2%  THEN 5240
5370  IF PFLG% < >1  THEN 5230
5380 INPT% =  -1
5390 WNDW% = 4: GOSUB 280
5400  VTAB VCUR%: HTAB 2
5410  PRINT " ";
5420  RETURN
5430  REM * PRINT BUSY ***
5440 WNDW% = 4
5450  GOSUB 280
5460  PRINT "*** PLEASE STAND BY ***"
5470  RETURN
5480  REM * DELAY *
5490  IF A% >0  THEN  FOR J = 1 TO A%: NEXT : RETURN
5500  REM * PAUSE ***
5510  PRINT
5520  INPUT "PRESS <RETURN> TO CONTINUE.";INPT$
5530  RETURN
5540  REM * PLAY A SOUND *
5550  IF A% <1  OR A% >4  THEN A% = 1
5560  FOR J = 1 TO A%: FOR K = 1 TO 10
5570 X =  PEEK( -16336) + PEEK( -16336)
5580  NEXT K: NEXT J: RETURN
5590  REM * SELECT AN ALT. *
5600 VFIR% = 3
5610 M1% = VFIR%
5620 VBOT% = VFIR% +ANUM% -1
5630 M2% = VBOT%
5640 PFLG% = 0
5650  GOSUB 5190
5660 ACUR% = INPT%
5670  RETURN
5680  REM * CONFIRM CHOICE ***
5690 WNDW% = 4: GOSUB 280
5700  PRINT A$
5710  PRINT "  EXECUTE <RETURN> OR CANCEL <ESC>? ";
5720  FLASH : PRINT " ": NORMAL
5730  GOSUB 5800
5740  IF INPT% = EXEC%  THEN INPT% = 1: GOTO 5770
5750  IF INPT% = CNCL%  THEN INPT% = 0: GOTO 5770
5760  GOTO 5730
5770 WNDW% = 4: GOSUB 280
5780  RETURN
5790  REM * GET KEYSTROKE ***
5800 INPT% =  PEEK( -16384) -128: POKE  -16368,0
5810  IF INPT% > -1  THEN  RETURN
5820 A% = 100: GOSUB 5490
5830  GOTO 5800
5840  REM * SELECT FACTOR *
5850 FCUR% = 1:PFLG% = 1
5860  GOSUB 590
5870 VLOC% = VFIR% +2
5880 M1% = VLOC%
5890 M2% = VBOT%: IF M2% >M1% +FACT% -FCUR%  THEN M2% = M1% +FACT% -FCUR%
5900  GOSUB 5190
5910  IF INPT% = 0  THEN FCUR% = 0: RETURN
5920  IF INPT% >0  THEN FCUR% = INPT% +FCUR% -1: RETURN
5930 FCUR% = FCUR% +FLNG%
5940  IF FCUR% >FACT%  THEN 5850
5950  GOTO 5860
5960  REM   * PRINT ANALYSIS *
5970 WNDW% = 4: GOSUB 280
5980  PRINT "ENTER PRINTER SLOT NUMBER (1 TO 5 OR 7;"
5990  PRINT "  PRESS <RETURN> FOR ";SLOT%;")";
6000  INPUT "? ";INPT$
6010  IF  LEN(INPT$) = 0  THEN 6050
6020 INPT% =  VAL(INPT$)
6030  IF INPT% <1  OR INPT% >7  OR INPT% = 6  THEN 5970
6040 SLOT% = INPT%
6050 WNDW% = 4: GOSUB 280
6060  PRINT "PREPARE PRINTER FOR OUTPUT."
6070  GOSUB 5510
6080  GOSUB 5440
6090  PRINT "*** PRESS ANY KEY TO INTERRUPT ***"
6100 PAGE% = 0
6110  PRINT CD$;"PR#";SLOT%
6120  GOSUB 6440
6130 VLOC% = LINE%
6140  GOSUB 450
6150 LINE% = LINE% +2 +ANUM%
6160  GOSUB 6540
6170  IF INPT% = 1  THEN 6380
6180  PRINT :LINE% = LINE% +1
6190 VLOC% = LINE% +2
6200 FCUR% = 1:TEMP% = FLNG%:FLNG% = FMAX%
6210  GOSUB 590
6220 FLNG% = TEMP%
6230  PRINT
6240 LINE% = LINE% +3 +FACT%
6250 FCUR% = 0
6260  GOSUB 6540: IF INPT% = 1  THEN 6380
6270 FCUR% = FCUR% +1
6280  IF FCUR% >FACT%  THEN 6380
6290  IF LINE% +3 +ANUM% <62  THEN 6320
6300  GOSUB 6650
6310  GOSUB 6440
6320 ACUR% = 1
6330 VLOC% = LINE% +2
6340  GOSUB 880
6350  PRINT
6360 LINE% = LINE% +3 +ANUM%
6370  GOTO 6260
6380  GOSUB 6650
6390  PRINT CD$;"PR#0"
6400 WNDW% = 4: GOSUB 280
6410 PAGE% = 0
6420  RETURN
6430  REM * PRINT HEADER *
6440  PRINT "."
6450  PRINT
6460 PAGE% = PAGE% +1
6470  PRINT
6480  PRINT NAME$; SPC( 65 - LEN(NAME$));"PAGE ";PAGE%
6490  PRINT
6500  PRINT
6510 LINE% = 7
6520  RETURN
6530  REM * CHECK FOR LISTING ABORT *
6540 INPT% =  PEEK( -16384) -128: POKE  -16368,0
6550  IF INPT% <0  THEN  RETURN
6560  PRINT CD$;"PR#0"
6570 A$ = "ABORT ANALYSIS LISTING -"
6580  GOSUB 5690
6590  IF INPT% = 1  THEN 6620
6600  GOSUB 5440
6610  PRINT "*** PRESS ANY KEY TO INTERRUPT ***"
6620  PRINT CD$;"PR#";SLOT%
6630  RETURN
6640  REM * PRINT FOOTER *
6650  IF LINE% >0  THEN  FOR J = LINE% TO 66
6660  PRINT
6670  NEXT
6680  RETURN
6690  REM * MAIN ROUTINE ******
6700  ONERR  GOTO 8430
6710  NOTRACE : SPEED= 255: PRINT  CHR$(4);"NOMON C,I,O"
6720  TEXT : HOME
6730  DATA  169,16,141,242,3,169,3,141,243,3,73,165,141,244,3,96,32,234,3,76,18,212,104,168,104,166,223,154,72,152,72,96
6740  FOR J = 768 TO 799
6750  READ K: POKE J,K
6760  NEXT
6770  CALL 768
6780  ONERR  GOTO 7650
6790 ERCNT = 0
6800  REM * INTRODUCE PROGRAM *
6810  DIM GSUM(5),GDES%(5,20),ARES(5),ADES$(5),FDES$(20),PDES%(20)
6820 WNDW% = 1: GOSUB 280
6830  PRINT "             THE ORACLE"
6840  PRINT
6850  PRINT "            BY JEFF G. COX             "
6860  PRINT "     STARFIRE CONCEPTS OF COLORADO     "
6870  PRINT "  COPYRIGHT 1983 BY MICROSPARC, INC."
6880  PRINT
6890  REM * DECLARE VARIABLES *
6900  REM * DECLARE CONSTANTS *
6910 ALNG% = 5
6920 AMAX% = 5
6930 CD$ =  CHR$(4)
6940 WLNG% = 25
6950 CNCL% = 27
6960 DEC% = 8
6970 EXEC% = 13
6980 FLNG% = 10
6990 FMAX% = 20
7000 ICR% = 21
7010 RET$ =  CHR$(13)
7020 SKIP% = 32
7030  REM * DECLARE VARIABLES *
7040 SFLG% = 0
7050 NAME$ = "TRADE STUDY"
7060 PAGE% = 0
7070 SLOT% = 1
7080 BFLG% = 1
7090  REM * HANDLE MAIN MENU *
7100 WNDW% = 3: GOSUB 280
7110 ERCNT = 0
7120 VBOT% = VFIR% +1
7130  PRINT "   START A NEW ANALYSIS"
7140  PRINT "   RETRIEVE AN ANALYSIS FROM DISC"
7150  IF BFLG% = 1  THEN 7260
7160  PRINT "   ADD AN ALTERNATIVE"
7170  PRINT "   DELETE AN ALTERNATIVE"
7180  PRINT "   CHANGE AN ALTERNATIVE'S NAME"
7190  PRINT "   ADD A FACTOR"
7200  PRINT "   DELETE A FACTOR"
7210  PRINT "   CHANGE A FACTOR'S PRIORITY"
7220  PRINT "   CHANGE A FACTOR'S NAME"
7230  PRINT "   CHANGE AN ALTERNATIVE'S GRADE"
7240  PRINT "   PRINT ANALYSIS";
7250 VBOT% = VFIR% +10
7260 M1% = VFIR%:M2% = VBOT%
7270 A$ = "DO YOU WANT TO":PFLG% = 0
7280  GOSUB 5190
7290  IF INPT% <1  THEN 7580
7300 WNDW% = 3: GOSUB 280
7310  ON INPT% GOTO 7330,7350,7370,7390,7410,7430,7450,7470,7490,7510,7540
7320  GOTO 7100
7330  GOSUB 4270
7340  GOTO 7560
7350  GOSUB 1590
7360  GOTO 7560
7370  GOSUB 2640
7380  GOTO 7560
7390  GOSUB 2870
7400  GOTO 7560
7410  GOSUB 3140
7420  GOTO 7560
7430  GOSUB 3400
7440  GOTO 7560
7450  GOSUB 3720
7460  GOTO 7560
7470  GOSUB 3970
7480  GOTO 7560
7490  GOSUB 4180
7500  GOTO 7560
7510 A$ = "TO CHOOSE AN ALTERNATIVE TO BE CHANGED,": GOSUB 5600
7520  IF ACUR% >0  THEN  GOSUB 2430
7530  GOTO 7560
7540  GOSUB 5970
7550  GOTO 7560
7560 BFLG% = 0
7570  GOTO 7100
7580  GOSUB 1290
7590 A$ = "EXIT PROGRAM -": GOSUB 5690
7600  IF INPT% < >1  THEN 7100
7610 WNDW% = 1: GOSUB 280
7620  PRINT "BYE . . ."
7630  GOTO 8430
7640  REM * ERROR PROCESSING **
7650  ONERR  GOTO 8310
7660  CALL 790
7670  IF PAGE% < >0  THEN  PRINT CD$;"PR#0"
7680 WNDW% = 4: GOSUB 280
7690 A% = 3: GOSUB 5550
7700  ON  PEEK(222) GOTO 8310,8310,8310,7740,8310,7800,8310,7880,7960,8030,8110,8310,8110
7710  IF  PEEK(222) = 56  OR  PEEK(222) = 255  THEN  HOME : CALL  -10621: GOTO 6820
7720  GOTO 8310
7730  REM  * WRITE-PROTECTED DISC
7740  FLASH : PRINT "WARNING";
7750  NORMAL : PRINT ":  DISC HAS WRITE PROTECT"
7760  PRINT "TAB.  REMOVE TAB OR GET ANOTHER DISC."
7770  GOSUB 5510
7780  GOTO 8260
7790  REM  * FILE NOT FOUND
7800  REM
7810  PRINT "I CAN'T FIND THAT NAME ON THIS DISC."
7820  PRINT "TRY A DIFFERENT NAME OR CHANGE DISCS."
7830  GOSUB 5510
7840 A$ = "TO CHANGE ANALYSIS NAME,"
7850  GOSUB 1140
7860  GOTO 8260
7870  REM  * I/O ERROR
7880 ERCNT = ERCNT +1
7890  IF ERCNT >3  THEN 8310
7900  FLASH : PRINT "WARNING";
7910  NORMAL : PRINT ":  DISC DRIVER ERROR; VERIFY"
7920  PRINT "DISC IS INSERTED AND DOOR IS CLOSED."
7930  GOSUB 5510
7940  GOTO 8260
7950  REM  * FULL DISC
7960  PRINT CD$;"DELETE ";NAME$
7970  FLASH : PRINT "WARNING";
7980  NORMAL : PRINT ":  DISC IS FULL.  PLEASE"
7990  PRINT "INSERT ANOTHER DISC."
8000  GOSUB 5510
8010  GOTO 8260
8020  REM  * FILE LOCKED
8030  FLASH : PRINT "WARNING";
8040  NORMAL : PRINT ":  FILE ALREADY EXISTS."
8050  INPUT "OK TO OVERWRITE (Y/N)? ";INPT$
8060  IF INPT$ < >"Y"  AND INPT$ < >"N"  THEN 8030
8070  IF INPT$ = "N"  THEN A$ = "TO CHANGE ANALYSIS NAME,": GOSUB 1140
8080  PRINT CD$;"UNLOCK ";NAME$
8085  PRINT CD$;"WRITE ";NAME$
8090  GOTO 8260
8100  REM   * FILE TYPE MISMATCH OR CTRL-C
8110  PRINT "THAT NAME IS NOT A SOUND TABLE."
8120  PRINT "PLEASE TRY A DIFFERENT NAME OR DISC."
8130  GOSUB 5510
8140 A$ = "TO CHANGE ANALYSIS NAME,"
8150  GOSUB 1140
8160  GOTO 8260
8170  REM  * RESET OR CTRL-C STOP
8180  FLASH : PRINT "WARNING";
8190  NORMAL : PRINT ":  DO NOT PRESS CTRL-C OR"
8200  PRINT "RESET.  DO YOU WISH TO ABORT THE"
8210  INPUT "PROGRAM (Y/N)? ";INPT$
8220  IF INPT$ = "!"  THEN  END
8230  IF INPT$ < >"Y"  AND INPT$ < >"N"  THEN 8180
8240  IF INPT$ = "Y"  THEN 8310
8250  GOTO 8260
8260 WNDW% = 4: GOSUB 280
8270  IF PAGE% < >0  THEN  PRINT CD$;"PR#";SLOT%
8280  ONERR  GOTO 7650
8290  RESUME
8300  REM * NON-RECOVERABLE ERRORS
8310  ONERR  GOTO 8410
8320  TEXT : HOME : IF  PEEK(222) = 56  OR  PEEK(222) = 255  THEN  CALL  -10621: GOTO 6820
8330  FLASH : PRINT "WARNING";
8340  NORMAL : PRINT ":  PROGRAM HAS BEEN ABORTED"
8350  PRINT "DUE TO ONERR CODE "; PEEK(222);" ON LINE "; PEEK(218) + PEEK(219) *256;"."
8360  PRINT
8370  PRINT "I WILL TRY TO SAVE YOUR ANALYSIS"
8380  PRINT "UNDER THE NAME OF 'ADUMP'."
8390 NAME$ = "ADUMP"
8400  PRINT CD$;"UNLOCK ";NAME$
8410  ONERR  GOTO 8430
8420 SFLG% = 1: GOSUB 1290
8430  END