'===========================================================================
' Subject: ARABIC TO ROMAN NUMERALS           Date: 02-22-96 (16:29)       
'  Author: Jeff S. Root                       Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: ALGOR.ABC
'===========================================================================
 ' ROMANCE.BAS * Arabic to Roman number translator
 ' Copyright MCMXCV by Jeff S. Root, Minneapolis, MN
 ' FREEWARE * Unlimited use and distribution * QBASIC
 
 DEFINT A-Z
 
 CLS : PRINT
 DO
   Arabic$ = ""
   PRINT "Number: ";
   LOCATE , , 1, 12, 13   'Cursor on
   DO
     DO: k$ = INKEY$: LOOP WHILE LEN(k$) <> 1      'Get input
     IF k$ = CHR$(27) THEN Arabic$ = "": EXIT DO   'Esc
     IF k$ = CHR$(8) AND Arabic$ > "" THEN
       Arabic$ = LEFT$(Arabic$, LEN(Arabic$) - 1)  'Backspace
       PRINT CHR$(29); " "; CHR$(29);
     ELSEIF k$ > "/" AND k$ < ":" THEN             '0-9 are ok
       IF k$ = "0" AND Arabic$ = "" THEN k$ = ""   'No lead 0s
       IF LEN(Arabic$) < 4 THEN
         Arabic$ = Arabic$ + k$: PRINT k$;      'Add character
       END IF
     END IF
   LOOP UNTIL k$ = CHR$(13)                     'Enter
   LOCATE , 1, 0: PRINT TAB(13); : LOCATE , 1   'Cursor off
   IF Arabic$ = "" THEN END                     'Exit ROMANCE
 
   a$ = "": b$ = "": c$ = "": d$ = ""
   n = LEN(Arabic$)
   SELECT CASE MID$(Arabic$, n, 1)
     CASE "1": a$ = "I"
     CASE "2": a$ = "II"
     CASE "3": a$ = "III"
     CASE "4": a$ = "IV"
     CASE "5": a$ = "V"
     CASE "6": a$ = "VI"
     CASE "7": a$ = "VII"
     CASE "8": a$ = "VIII"
     CASE "9": a$ = "IX"
   END SELECT
   n = n - 1
   IF n THEN
     SELECT CASE MID$(Arabic$, n, 1)
       CASE "1": b$ = "X"
       CASE "2": b$ = "XX"
       CASE "3": b$ = "XXX"
       CASE "4": b$ = "XL"
       CASE "5": b$ = "L"
       CASE "6": b$ = "LX"
       CASE "7": b$ = "LXX"
       CASE "8": b$ = "LXXX"
       CASE "9": b$ = "XC"
     END SELECT
     n = n - 1
     IF n THEN
       SELECT CASE MID$(Arabic$, n, 1)
         CASE "1": c$ = "C"
         CASE "2": c$ = "CC"
         CASE "3": c$ = "CCC"
         CASE "4": c$ = "CD"
         CASE "5": c$ = "D"
         CASE "6": c$ = "DC"
         CASE "7": c$ = "DCC"
         CASE "8": c$ = "DCCC"
         CASE "9": c$ = "CM"
       END SELECT
       n = n - 1
       IF n THEN
         n = VAL(MID$(Arabic$, n, 1))
         FOR i = 1 TO n: d$ = d$ + "M": NEXT i
       END IF
     END IF
   END IF
   PRINT CHR$(30);
   PRINT SPC(4 - LEN(Arabic$)); Arabic$; " = ";
   PRINT d$; c$; b$; a$
   PRINT
 LOOP