'********************************************************************** ' ROMANUM.BAS - Roman to Arabic number translator ' ========== Umwandlung von roemischen in arabische Zahlen ' ' Subject: ROMAN TO ARABIC # TRANSLATOR Date: 02-11-96 (10:30) ' Author: Jeff S. Root Code: QB, QBasic, PDS ' Origin: FidoNet QUIK_BAS Echo Packet: ALGOR.ABC '=========================================================================== ' ' There are 7 letters used as roman numerals: ' I=1, V=5, X=10, L=50, C=100, D=500, M=1000 ' Sometimes, also the lower-case letters are used. ' In fact, lower-case letters were not invented until the Middle ' Ages, well after the Roman Empire had dissolved. And until a ' couple of hundred years ago, there was no subtraction in Roman ' numbers. The number "4" was always written as "IIII", and "9" ' was always written as "VIIII", for example. The shorthand use ' of "IV" and "IX" is a relatively recent invention. The old ' form is easier for doing calculations. ' ' (c) MCMXCV by Jeff S. Root, Minneapolis, MN '********************************************************************** ' DEFINT A-Z: DIM Num(22) CLS : PRINT DO Roman$ = "": Arabic = 0: BadFlag = 0: ERASE Num PRINT "Roman numerals: "; LOCATE , , 1, 12, 13 'Cursor on DO DO: k$ = UCASE$(INKEY$): LOOP WHILE k$ = "" IF k$ = CHR$(27) THEN Roman$ = "": EXIT DO 'Esc IF k$ = CHR$(8) AND Roman$ > "" THEN Roman$ = LEFT$(Roman$, LEN(Roman$) - 1) 'Backspace PRINT CHR$(29); " "; CHR$(29); ELSEIF INSTR(1, "IVXLCDM", k$) THEN IF LEN(Roman$) < 21 THEN Roman$ = Roman$ + k$: PRINT k$; 'Add character END IF END IF LOOP UNTIL k$ = CHR$(13) 'Enter LOCATE , 1, 0: PRINT TAB(38); : LOCATE , 1 'Cursor off ' IF Roman$ = "" THEN END 'Exit ROMANUM FOR n = 1 TO LEN(Roman$) SELECT CASE MID$(Roman$, n, 1) CASE "I": Num(n) = 1 CASE "V": Num(n) = 5 CASE "X": Num(n) = 10 CASE "L": Num(n) = 50 CASE "C": Num(n) = 100 CASE "D": Num(n) = 500 CASE "M": Num(n) = 1000 END SELECT NEXT n FOR n = 1 TO LEN(Roman$) - 1 IF Num(n) < Num(n + 1) OR Num(n) < Num(n + 2) THEN IF INSTR(1, "VLD", MID$(Roman$, n, 1)) THEN IF BadFlag = 0 THEN BadFlag = 1 ELSEIF Num(n - 1) = Num(n) AND Num(n) = Num(n + 1) THEN IF BadFlag = 0 THEN BadFlag = 2 ELSEIF Num(n) = Num(n + 2) THEN IF BadFlag = 0 THEN BadFlag = 3 ELSEIF Num(n) < Num(n + 2) AND Num(n) <> Num(n + 1) THEN IF BadFlag = 0 THEN BadFlag = 4 END IF Arabic = Arabic - Num(n) ELSE Arabic = Arabic + Num(n) END IF NEXT n Arabic = Arabic + Num(n) 'Add final character IF BadFlag THEN PRINT Roman$; " is bad format: "; SELECT CASE BadFlag CASE 1: PRINT "Multiples of five may not be subtracted."; CASE 2: PRINT "Only two subtractions allowed together."; CASE 3: PRINT "This adds and subtracts the same value."; CASE 4: PRINT "Put high values before low values."; END SELECT LOCATE , 1: SLEEP 4: k$ = INKEY$ 'Clear keybuffer PRINT TAB(80); : LOCATE , 1 ELSE PRINT CHR$(30); 'Up a line PRINT TAB(22 - LEN(Roman$)); Roman$; " = "; Arabic PRINT END IF LOOP