home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug054.ark / FRACT.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  1.7 KB  |  70 lines
  1. 10 !
  2. 20 !    PROGRAM:    FRACTION.BAS
  3. 30 !    AUTHOR:        MICHAEL RUF
  4. 40 !    DATE:        AUGUST 20,1979
  5. 50 !
  6. 60 ?
  7. 70 ?"FRACTION MATH"
  8. 80 ?
  9. 90 ?
  10. 100 ?"VALID SIGNS: -+*/"
  11. 110 ?
  12. 120 ?
  13. 125 P=1:E$=CHR$(155)
  14. 130 GOSUB 5000
  15. 140 IF P=1 AND A<48 AND A<>46 THEN ?CHR$(7);:GOTO 130
  16. 142 IF P=2 AND A<48 AND A<>46 THEN 300
  17. 150 PRINT CHR$(A);
  18. 160 EQ$=EQ$+CHR$(A)
  19. 165 LE=LE+1
  20. 170 GOTO 130
  21. 300 EQ$=EQ$+CHR$(A)
  22. 305 P=P+1:LE=0
  23. 310 PRINT E$"A";
  24. 320 FOR I=1 TO LE+2
  25. 330 ?E$"C";
  26. 340 NEXT
  27. 350 PRINT CHR$(A);E$"A";"  ";
  28. 5000 WAIT &72,255,2
  29. 5010 A=INP(&73)-128
  30. 5012 IF P=4 AND A=61 THEN 6000
  31. 5015 IF P/2<>P\2 AND A=13 THEN ?E$"B";:FOR I=1 TO LE:
  32.      ?E$"D-";E$"D";:NEXT:?E$"B";:EQ$=EQ$+CHR$(13):LE=0:P=P+1:GOTO 130
  33. 5020 IF A>41 AND A<58 AND A<>44 THEN RETURN ELSE ?CHR$(7);:GOTO 5000
  34. 6000 ?E$"A";
  35. 6010 FOR I=1 TO LE+2
  36. 6020 ?E$"C";
  37. 6030 NEXT
  38. 6040 PRINT "=";E$"A  ";
  39. 6100 CO=0:P=0
  40. 6110 CO=CO+1
  41. 6115 CH$=MID$(EQ$,CO,1)
  42. 6120 IF CH$=CHR$(13) THEN P=P+1:EQ$(P)=MID$(EQ$,1,CO-1):EQ$=MID$(EQ$,CO+1):C=0:GOTO 6110
  43. 6125 IF P=2 THEN EQ$(3)=EQ$:GOTO 6200
  44. 6130 GOTO 6110
  45. 6200 N1=VAL(EQ$(1))
  46. 6210 D1=VAL(EQ$(2))
  47. 6220 CO=0
  48. 6230 CO=CO+1
  49. 6240 CH$=MID$(EQ$(2),CO,1)
  50. 6250 IFCH$<"0"ANDCH$<>"." THEN S$=CH$:EQ$(2)=MID$(EQ$(2),CO+1) ELSE 6230
  51. 6260 N2=VAL(EQ$(2))
  52. 6270 D2=VAL(EQ$(3))
  53. 6280 IF S$="*" THEN D=D1*D2:N=N1*N2:GOTO 10000
  54. 6290 IF S$="/" THEN D=D1*N2:N=N1*D2:GOTO 10000
  55. 10000 ! REDUCE FRACTION
  56. 10010 IF D/N=D\N THEN D=D/N:N=1
  57. 10020 IF N/D=N\D THEN N=N/D:D=1
  58. 10030 IF N>D THEN X=D/2 ELSE X=N/2
  59. 10040 FOR I=2 TO X
  60. 10050 IF N/I=N\I AND D/I=D\I THEN N=N/I:D=D/I:EXIT 10030
  61. 10060 NEXT I
  62. 10070 PRINT N;E$"B";
  63. 10080 FOR I=1 TO LEN(STR$(N))-1
  64. 10090 PRINT E$"D";E$"D-";
  65. 10100 NEXT I
  66. 10110 PRINT E$"B";E$"D";E$"D";D
  67. 10120 ?:?:?
  68. 10125 CLEAR
  69. 10130 GOTO 125
  70.