home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib35b.dsk / ROMAN.NUMERALS.bas < prev    next >
BASIC Source File  |  2023-02-26  |  8KB  |  172 lines
  1. 10  REM  *
  2. 20  REM  * ROMAN.NUMERALS
  3. 30  REM  * BY ANTONIO DE PASQUALE 
  4. 40  REM  * COPYRIGHT (C) 1988
  5. 50  REM  * BY MICROSPARC, INC.
  6. 60  REM  * CONCORD, MA 01742
  7. 70  REM  *
  8. 80  REM  ============
  9. 90  REM  TITLE SCREEN
  10. 100  REM ============
  11. 110  PRINT  CHR$(21): REM ACTIVATE 40-COLUMNS
  12. 120  TEXT : HOME : CLEAR 
  13. 130  DIM NV$(39): FOR X = 1 TO 15: READ NV$(X): NEXT X: REM INITIALIZE VARIABLES
  14. 140  PRINT  TAB( 5)"ROMAN/DECIMAL NUMBER CONVERTER": PRINT  TAB( 9)"BY ANTONIO DE PASQUALE": PRINT  TAB( 8)"(C) 1988 MICROSPARC, INC.": PRINT : PRINT 
  15. 150  PRINT "PLEASE CHOOSE ONE OF THE FOLLOWING:": PRINT 
  16. 160  PRINT "   1. CONVERT ROMAN TO DECIMAL": PRINT 
  17. 170  PRINT "   2. CONVERT DECIMAL TO ROMAN": PRINT 
  18. 180  PRINT "   3. EXIT PROGRAM": PRINT 
  19. 190  PRINT "YOUR CHOICE: ";
  20. 200  VTAB 14: HTAB 14: GET K$: IF K$ = "1"  THEN  PRINT K$: CALL  -958: GOTO 270
  21. 210  IF K$ = "2"  THEN  PRINT K$: CALL  -958: GOTO 990
  22. 220  IF K$ < >"3" GOTO 200
  23. 230  CALL  -958: PRINT K$: PRINT : PRINT "DO YOU REALLY WANT TO QUIT (";: INVERSE : PRINT "Y/N";: NORMAL : PRINT "): ";
  24. 240  POKE  -16368,0: GET K$
  25. 250  IF K$ = "Y"  OR K$ = "y"  THEN  TEXT : HOME : VTAB 23: END 
  26. 260  GOTO 120
  27. 270  REM ================
  28. 280  REM ROMAN TO DECIMAL
  29. 290  REM ================
  30. 300 IC = 15:DN = 0:T2 = 0: VTAB 16: HTAB 1: CALL  -958
  31. 310 RN$ = "":LL = 0: PRINT "ENTER A ROMAN NUMERAL: ";
  32. 320  GET K$: ON (K$ =  CHR$(27)  AND LL = 0) GOTO 120: ON (K$ =  CHR$(32)  OR K$ =  CHR$(21)) GOTO 320: ON (K$ =  CHR$(8)  AND LL = 0) GOTO 320: IF K$ =  CHR$(8)  THEN LL = LL -1:RN$ =  MID$ (RN$,1,LL): PRINT  CHR$(8);" "; CHR$(8);: GOTO 320
  33. 330  IF K$ > = "a"  AND K$ < = "z"  THEN K$ =  CHR$(( ASC(K$)) -32)
  34. 340  IF K$ =  CHR$(27)  AND LL >0  THEN  GOTO 300
  35. 350  IF K$ =  CHR$(13)  AND LL = 0  THEN 320
  36. 360  IF K$ =  CHR$(13)  AND LL >0  THEN  PRINT : GOTO 410
  37. 370  PRINT K$;:RN$ = RN$ +K$:LL = LL +1: GOTO 320
  38. 380  REM ===
  39. 390  REM === CHECK IF LEGAL
  40. 400  REM ===
  41. 410  FOR X = 1 TO  LEN(RN$)
  42. 420 X$ =  MID$ (RN$,X,1)
  43. 430  IF X$ < >"M"  AND X$ < >"D"  AND X$ < >"C"  AND X$ < >"L"  AND X$ < >"X"  AND X$ < >"V"  AND X$ < >"I"  THEN  PRINT : PRINT "ILLEGAL ENTRY!  PLEASE PRESS <";: INVERSE : PRINT "RETURN";: NORMAL : PRINT ">": PRINT "TO CONTINUE: ";: POKE  -16368,0: GET K$: GOTO 300
  44. 440  NEXT X
  45. 450  REM ===
  46. 460  REM === CONVERT VALUES
  47. 470  REM ===
  48. 480 C = 0:ER = 0:HV = 1000
  49. 490  FOR X = 1 TO  LEN(RN$)
  50. 500 T1$ =  MID$ (RN$,X,1):T2$ =  MID$ (RN$,(X +1),1)
  51. 510  IF T1$ = "M"  THEN T1 = 1000
  52. 520  IF T1$ = "D"  THEN T1 = 500
  53. 530  IF T1$ = "C"  THEN T1 = 100
  54. 540  IF T1$ = "L"  THEN T1 = 50
  55. 550  IF T1$ = "X"  THEN T1 = 10
  56. 560  IF T1$ = "V"  THEN T1 = 5
  57. 570  IF T1$ = "I"  THEN T1 = 1
  58. 580  IF T2$ = "M"  THEN T2 = 1000
  59. 590  IF T2$ = "D"  THEN T2 = 500
  60. 600  IF T2$ = "C"  THEN T2 = 100
  61. 610  IF T2$ = "L"  THEN T2 = 50
  62. 620  IF T2$ = "X"  THEN T2 = 10
  63. 630  IF T2$ = "V"  THEN T2 = 5
  64. 640  IF T2$ = "I"  THEN T2 = 1
  65. 650  REM  ===
  66. 660  REM  === CHECK FOR ILLEGAL ROMAN NUMERALS
  67. 670  REM  ===
  68. 680  GOSUB 1660
  69. 690  IF ER = 1  THEN  GOTO 760
  70. 700  IF T1 >HV  OR T2 >HV  THEN ER = 1
  71. 710  IF T1$ = T2$  THEN C = C +1: GOSUB 1590: GOTO 760
  72. 720 C = 0
  73. 730  IF T1 <T2  THEN NV$(IC +1) = T1$ +T2$:NV$(IC +2) = T2$ +T1$:NV$(IC +3) = T1$ +T1$:NV$(IC +4) = T2$ +T2$:IC = IC +4
  74. 740  IF T1 >T2  THEN HV = T1: GOTO 760
  75. 750 HV = T2
  76. 760  IF ER = 1  THEN  VTAB 18: PRINT "ILLEGAL ROMAN NUMERAL, PRESS <";: INVERSE : PRINT "RETURN";: NORMAL : PRINT "> TOCONTINUE.";: POKE  -16368,0: GET K$: GOTO 300
  77. 770  REM  ===
  78. 780  REM  === ROMAN NUMERAL CALCULATION
  79. 790  REM  ===
  80. 800  IF T1 <T2  THEN T1 =  -T1
  81. 810 DN = DN +T1
  82. 820 T1 = 0:T2 = 0
  83. 830  NEXT X
  84. 840  REM ===
  85. 850  REM === PRINT THE RESULT
  86. 860  REM ===
  87. 870  PRINT : PRINT "THE DECIMAL EQUIVALENT OF ";: INVERSE : PRINT RN$;: NORMAL : PRINT 
  88. 880  PRINT "IS.....";: INVERSE : PRINT DN;: NORMAL : PRINT 
  89. 890  REM ===============
  90. 900  REM ASK TO CONTINUE
  91. 910  REM ===============
  92. 920  PRINT : PRINT "DO YOU WISH TO DO ANOTHER": PRINT "CONVERSION (";: INVERSE : PRINT "Y/N";: NORMAL : PRINT ") ";
  93. 930  POKE  -16368,0: GET K$: IF K$ = "Y"  OR K$ = "y"  THEN  GOTO 120
  94. 940  IF K$ = "N"  OR K$ = "n"  THEN 230
  95. 950  GOTO 930
  96. 960  REM ================
  97. 970  REM DECIMAL TO ROMAN
  98. 980  REM ================
  99. 990  VTAB 16: HTAB 1: CALL  -958
  100. 1000 DN$ = "":LL = 0: PRINT "ENTER A DECIMAL NUMBER: ";
  101. 1010  GET K$: ON (K$ =  CHR$(27)  AND LL = 0) GOTO 120: ON (K$ =  CHR$(32)  OR K$ =  CHR$(21)) GOTO 1010: ON (K$ =  CHR$(8)  AND LL = 0) GOTO 1010: IF K$ =  CHR$(8)  THEN LL = LL -1:DN$ =  MID$ (DN$,1,LL): PRINT  CHR$(8);" "; CHR$(8);: GOTO 1010
  102. 1020  IF K$ =  CHR$(27)  AND LL >0  THEN  GOTO 990
  103. 1030  IF K$ =  CHR$(13)  AND LL = 0  THEN 1010
  104. 1040  IF K$ =  CHR$(13)  AND LL >0  THEN  PRINT :DN =  VAL(DN$): GOTO 1090
  105. 1050  PRINT K$;:DN$ = DN$ +K$:LL = LL +1: GOTO 1010
  106. 1060  REM ===
  107. 1070  REM ===CHECK IF LEGAL
  108. 1080  REM ===
  109. 1090  IF  LEN(DN$) <4  THEN DN$ = "0" +DN$: GOTO 1090: REM  PAD TO 4 CHARACTERS
  110. 1100  FOR Y = 1 TO  LEN(DN$): IF  MID$ (DN$,Y,1) <"0"  OR  MID$ (DN$,Y,1) >"9"  THEN  PRINT : PRINT "ILLEGAL ENTRY!  PLEASE PRESS <";: INVERSE : PRINT "RETURN";: NORMAL : PRINT ">": PRINT "TO CONTINUE: ";: POKE  -16368,0: GET K$: GOTO 990
  111. 1110  NEXT Y
  112. 1120  IF  LEN(DN$) >4  THEN  PRINT : PRINT "NUMBER MUST BE ";: INVERSE : PRINT "9999";: NORMAL : PRINT " OR LESS.": PRINT "PRESS <";: INVERSE : PRINT "RETURN";: NORMAL : PRINT "> TO CONTINUE: ";: POKE  -16368,0: GET K$: GOTO 990
  113. 1130  IF  VAL(DN$) < = 0  THEN  PRINT : PRINT "NUMBER MUST BE GREATER THAN ZERO.": PRINT "PLEASE PRESS <";: INVERSE : PRINT "RETURN";: NORMAL : PRINT "> TO CONTINUE: ";: POKE  -16368,0: GET K$: GOTO 990
  114. 1140  REM ===
  115. 1150  REM ===CONVERT ONE'S
  116. 1160  REM ===
  117. 1170 O$ =  RIGHT$(DN$,1)
  118. 1180  IF O$ = "0"  THEN RN$ = "": GOTO 1270
  119. 1190  IF O$ <"4"  THEN  FOR Y = 1 TO  VAL(O$):RN$ = RN$ +"I": NEXT Y: GOTO 1270
  120. 1200  IF O$ = "4"  THEN RN$ = RN$ +"IV": GOTO 1270
  121. 1210  IF O$ = "5"  THEN RN$ = RN$ +"V": GOTO 1270
  122. 1220  IF O$ < = "8"  THEN  FOR Y = 6 TO  VAL(O$):RN$ = RN$ +"I": NEXT Y:RN$ = "V" +RN$: GOTO 1270
  123. 1230  IF O$ = "9"  THEN RN$ = "IX": GOTO 1270
  124. 1240  REM ===
  125. 1250  REM === CONVERT TENS
  126. 1260  REM ===
  127. 1270 TE$ =  MID$ (DN$,3,1)
  128. 1280  IF TE$ = "0"  THEN  GOTO 1370
  129. 1290  IF TE$ < = "3"  THEN  FOR Y = 1 TO  VAL(TE$):RN$ = "X" +RN$: NEXT Y: GOTO 1370
  130. 1300  IF TE$ = "4"  THEN RN$ = "XL" +RN$: GOTO 1370
  131. 1310  IF TE$ = "5"  THEN RN$ = "L" +RN$: GOTO 1370
  132. 1320  IF TE$ < = "8"  THEN  FOR Y = 6 TO  VAL(TE$):X$ = X$ +"X": NEXT Y:RN$ = "L" +X$ +RN$: GOTO 1370
  133. 1330  IF TE$ = "9"  THEN RN$ = "XC" +RN$: GOTO 1370
  134. 1340  REM ===
  135. 1350  REM ===CONVERT HUNDREDS
  136. 1360  REM ===
  137. 1370 H$ =  MID$ (DN$,2,1)
  138. 1380  IF H$ = "0"  THEN  GOTO 1470
  139. 1390  IF H$ < = "3"  THEN  FOR Y = 1 TO  VAL(H$):RN$ = "C" +RN$: NEXT Y: GOTO 1470
  140. 1400  IF H$ = "4"  THEN RN$ = "CD" +RN$: GOTO 1470
  141. 1410  IF H$ = "5"  THEN RN$ = "D" +RN$: GOTO 1470
  142. 1420  IF H$ < = "8"  THEN  FOR Y = 6 TO  VAL(H$):C$ = C$ +"C": NEXT Y:RN$ = "D" +C$ +RN$: GOTO 1470
  143. 1430  IF H$ = "9"  THEN RN$ = "CM" +RN$: GOTO 1470
  144. 1440  REM ===
  145. 1450  REM ===CONVERT THOUSANDS
  146. 1460  REM ===
  147. 1470 TH$ =  LEFT$(DN$,1)
  148. 1480  IF TH$ = "0"  THEN  GOTO 1530
  149. 1490  FOR Y = 1 TO  VAL(TH$):RN$ = "M" +RN$: NEXT Y
  150. 1500  REM ===
  151. 1510  REM === PRINT THE RESULT
  152. 1520  REM ===
  153. 1530  PRINT : PRINT "THE ROMAN EQUIVALENT OF ";: INVERSE : PRINT DN$;: NORMAL : PRINT 
  154. 1540  PRINT "IS.....";: INVERSE : PRINT RN$;: NORMAL : PRINT 
  155. 1550  GOTO 920: REM  SEE IF USER WANTS TO DO MORE
  156. 1560  REM  ==========================
  157. 1570  REM  ERROR CHECKING SUBROUTINES
  158. 1580  REM  ==========================
  159. 1590 ER = 0
  160. 1600 HV = T1
  161. 1610  IF T1$ = "M"  AND C < = 8  THEN  RETURN 
  162. 1620  IF T1$ = "C"  AND C < = 2  THEN  RETURN 
  163. 1630  IF T1$ = "X"  AND C < = 2  THEN  RETURN 
  164. 1640  IF T1$ = "I"  AND C < = 2  THEN  RETURN 
  165. 1650 ER = 1: RETURN 
  166. 1660 ER = 0
  167. 1670 TP$ = T1$ +T2$
  168. 1680  FOR Y = 1 TO IC
  169. 1690  IF TP$ = NV$(Y)  THEN ER = 1
  170. 1700  NEXT Y
  171. 1710  RETURN 
  172. 1720  DATA  "IM","VM","XM","LM","DM","ID","VD","XD","LD","IC","VC","LC","IL","VL","VX"