RBBS in a Box Volume 1 #3.1/RBBSIABOX31.cdr/fwrd/fraction.bas

BASIC Source File | 1990-09-29 | 6KB | 280 lines

10 ' ***************************************
20 ' **        FRACTIONS                  **
30 ' ***************************************
40 '
50 CLEAR
60 SCREEN 0,0,0,0
70 CLS
80 KEY OFF
90 DEFDBL A-Z
100 LOCATE 1,28
110 PRINT "* * * FRACTIONS * * *
120 LOCATE 3,1
130 PRINT  "FUNCTIONS FOR TWO FRACTIONS ...
140 PRINT
150 PRINT TAB(22)"F1.   FRACTION 1   +  FRACTION 2
160 PRINT TAB(22)"F2.   FRACTION 1   -  FRACTION 2
170 PRINT TAB(22)"F3.   FRACTION 1   *  FRACTION 2
180 PRINT TAB(22)"F4.   FRACTION 1   /  FRACTION 2
190 PRINT
200 PRINT "FUNCTIONS OF TWO NUMBERS ...
210 PRINT
220 PRINT TAB(22)"F5.   GREATEST COMMON DIVISOR
230 PRINT TAB(22)"F6.   LEAST COMMON MULTIPLE
240 PRINT TAB(22)"F7.   REDUCTION TO LOWEST TERMS
250 PRINT
260 PRINT "FUNCTION OF ONE NUMBER  ...
270 PRINT
280 PRINT TAB(22)"F8.   DECIMAL TO FRACTION APPROXIMATION
290 PRINT TAB(22)"F9.   FRACTION TO DECIMAL CONVERSION
300 PRINT
310 PRINT
320 PRINT TAB(22)"F10.  QUIT
330 LOCATE 25,22
340 PRINT "PRESS ANY SPECIAL FUNCTION KEY";
350 ON KEY(1) GOSUB 620
360 ON KEY(2) GOSUB 730
370 ON KEY(3) GOSUB 840
380 ON KEY(4) GOSUB 950
390 ON KEY(5) GOSUB 1060
400 ON KEY(6) GOSUB 1180
410 ON KEY(7) GOSUB 1300
420 ON KEY(8) GOSUB 1420
430 ON KEY(9) GOSUB 1790
440 ON KEY(10) GOSUB 1920
450 KEY(1) ON
460 KEY(2) ON
470 KEY(3) ON
480 KEY(4) ON
490 KEY(5) ON
500 KEY(6) ON
510 KEY(7) ON
520 KEY(8) ON
530 KEY(9) ON
540 KEY(10) ON
550 '
560 WHILE QUIT = NOT.YET
570 KEY.BUFFER.CLEAR$ = INKEY$
580 WEND
590 CLS
600 END
610 '
620 ' F1 SUBROUTINE
630 FUN$ = "+"
640 SCREEN 0,0,1,1
650 GOSUB 1970
660 N = N1 * D2 + N2 * D1
670 D = D1 * D2
680 GOSUB 2330
690 GOSUB 2440
700 SCREEN 0,0,0,0
710 RETURN
720 '
730 ' F2 SUBROUTINE
740 FUN$ = "-"
750 SCREEN 0,0,1,1
760 GOSUB 1970
770 N = N1 * D2 - N2 * D1
780 D = D1 * D2
790 GOSUB 2330
800 GOSUB 2440
810 SCREEN 0,0,0,0
820 RETURN
830 '
840 ' F3 SUBROUTINE
850 FUN$ = "*"
860 SCREEN 0,0,1,1
870 GOSUB 1970
880 N = N1 * N2
890 D = D1 * D2
900 GOSUB 2330
910 GOSUB 2440
920 SCREEN 0,0,0,0
930 RETURN
940 '
950 ' F4 SUBROUTINE
960 FUN$ = "/"
970 SCREEN 0,0,1,1
980 GOSUB 1970
990 N = N1 * D2
1000 D = D1 * N2
1010 GOSUB 2330
1020 GOSUB 2440
1030 SCREEN 0,0,0,0
1040 RETURN
1050 '
1060 ' F5 SUBROUTINE
1070 SCREEN 0,0,1,1
1080 CLS
1090 LOCATE 7,14
1100 INPUT "GREATEST COMMON DIVISOR. ENTER 'A,B' ";A,B
1110 GOSUB 2670
1120 LOCATE 14,14
1130 PRINT "GREATEST COMMON DIVISOR IS ";GCD
1140 GOSUB 2600
1150 SCREEN 0,0,0,0
1160 RETURN
1170 '
1180 ' F6 SUBROUTINE
1190 SCREEN 0,0,1,1
1200 CLS
1210 LOCATE 7,14
1220 INPUT "LEAST COMMON MULTIPLE. ENTER 'A,B' ";A,B
1230 GOSUB 2750
1240 LOCATE 14,14
1250 PRINT "LEAST COMMON MULTIPLE IS ";LCM
1260 GOSUB 2600
1270 SCREEN 0,0,0,0
1280 RETURN
1290 '
1300 ' F7 SUBROUTINE
1310 SCREEN 0,0,1,1
1320 CLS
1330 LOCATE 7,14
1340 INPUT "REDUCE TO LOWEST TERMS. ENTER 'A,B' ";N,D
1350 GOSUB 2330
1360 LOCATE 14,14
1370 PRINT "REDUCED TO LOWEST TERMS =  ";N;"  ";D
1380 GOSUB 2600
1390 SCREEN 0,0,0,0
1400 RETURN
1410 '
1420 ' F8 SUBROUTINE
1430 SCREEN 0,0,1,1
1440 CLS
1450 LOCATE 7,9
1460 INPUT "DECIMAL TO FRACTION CONVERSION.  ENTER X ";X
1470 PRINT
1480 PRINT TAB(14)"FRACTION"TAB(47)"ERROR FROM X"
1490 PRINT TAB(13)"-------------"TAB(44)"------------------"
1500 T1 = 1
1510 T2 = 1
1520 T3 = 1
1530 T4 = INT(X)
1540 T5 = X - T4
1550 T7 = 0
1560 T8 = 0
1570 DIF = 1
1580   WHILE ABS(DIF) > 1E-15
1590   NUM = T3 * T4 + T7
1600   DEN = T4 * T8 + T2
1610   DIF = NUM / DEN - X
1620   IF T5 = 0 THEN 1710
1630   T4 = INT(T1/T5)
1640   T6 = T5
1650   T5 = T1 - T4 * T5
1660   T1 = T6
1670   T7 = T3
1680   T3 = NUM
1690   T2 = T8
1700   T8 = DEN
1710   PRINT TAB(14)NUM;" / ";DEN;
1720   PRINT TAB(49);
1730   PRINT USING "+#.#^^^^" ;DIF
1740   WEND
1750 GOSUB 2600
1760 SCREEN 0,0,0,0
1770 RETURN
1780 '
1790 ' F9 SUBROUTINE
1800 SCREEN 0,0,1,1
1810 CLS
1820 LOCATE 7,1
1830 PRINT "ENTER A FRACTION,
1840 LINE INPUT "'NUMERATOR/DENOMINATOR' ...";FR$
1850 GOSUB 2160
1860 LOCATE 12,30
1870 PRINT "= ";NF/DF
1880 GOSUB 2600
1890 SCREEN 0,0,0,0
1900 RETURN
1910 '
1920 ' F10 SUBROUTINE
1930 QUIT = 1
1940 RETURN
1950 '
1960 ' SUBROUTINE, INPUT TWO FRACTIONS
1970 CLS
1980 LOCATE 7,1
1990 PRINT "ENTER FIRST FRACTION,
2000 LINE INPUT "'NUMERATOR/DENOMINATOR' ...";FR$
2010 GOSUB 2160
2020 N1=NF
2030 D1=DF
2040 PRINT "ENTER SECOND FRACTION,
2050 LINE INPUT "'NUMERATOR/DENOMINATOR' ...";FR$
2060 IF INSTR(FR$,".") = 0 THEN 2100
2070 BEEP
2080 PRINT TAB(40)"NO DECIMAL POINTS PLEASE"
2090 GOTO 2050
2100 GOSUB 2160
2110 N2 = NF
2120 D2 = DF
2130 RETURN
2140 '
2150 ' SUBROUTINE, FR$ TO NF AND DF
2160 IP = INSTR(FR$,",")
2170 IF IP =0 THEN 2200
2180 MID$(FR$,IP,1)="/"
2190 GOTO 2160
2200 IP =INSTR(FR$,"/")
2210 IF IP THEN 2240
2220 FR$=FR$ +"/1"
2230 GOTO 2200
2240 NF =VAL(LEFT$(FR$,IP))
2250 DF= VAL(MID$(FR$,IP+1))
2260 IF INSTR(FR$,"N") THEN NF=N
2270 IF INSTR(FR$,"n") THEN NF=N
2280 IF INSTR(FR$,"D") THEN DF=D
2290 IF INSTR(FR$,"d") THEN DF=D
2300 RETURN
2310 '
2320 'SUBROUTINE, REDUCTION OF N AND D TO LOWEST TERMS
2330 A = N
2340 B = D
2350 GOSUB 2670
2360 N = N / GCD
2370 D = D / GCD
2380 IF SGN(D) > -1 THEN 2410
2390 N = -N
2400 D = -D
2410 RETURN
2420 '
2430 ' SUBROUTINE OUTPUT OF TWO FRACTION PROBLEM RESULTS
2440 CLS
2450 LOCATE 7,27
2460 PRINT N1;"/";D1;"   ";FUN$;"   ";N2;"/";D2
2470 LOCATE 10,30
2480 IF D=<> 1 THEN 2510
2490 PRINT "=   ";N
2500 GOTO 2560
2510 PRINT"=  ";N;"/";D
2520 IF ABS(N) < D THEN 2560
2530 LOCATE 12,30
2540 NUM = VAL(LEFT$(STR$(N/D),INSTR(STR$(N/D),".")))
2550 PRINT "=   ";NUM;" AND ";N - NUM * D;"/";D
2560 GOSUB 2600
2570 RETURN
2580 '
2590 ' SUBROUTINE,WAIT UNTIL USER WANTS TO PROCEED
2600 LOCATE 25,25
2610 PRINT "PRESS THE SPACE BAR TO CONTINUE ";
2620 K$=INKEY$
2630 IF K$ <> " " THEN 2620
2640 RETURN
2650 '
2660 ' SUBROUTINE GREATEST COMMON DIVISOR OF A AND B
2670 TEMP = A - B * INT(A/B)
2680 A = B
2690 B = TEMP
2700 IF TEMP THEN 2670
2710 GCD = A
2720 RETURN
2730 '
2740 'SUBROUTINE , LEAST COMMON MULTIPLE OF A AND B
2750 A2=A
2760 B2=B
2770 GOSUB 2670
2780 LCM =ABS(A2*B2/ GCD)
2790 RETURN