RosettaCodeData/Task/Roman-numerals-Encode/XBasic/roman-numerals-encode.basic

59 lines
1.2 KiB
Plaintext

PROGRAM "romanenc"
VERSION "0.0000"
DECLARE FUNCTION Entry()
INTERNAL FUNCTION ToRoman$(aValue%%)
' 3888 or MMMDCCCLXXXVIII (15 chars) is the longest string properly encoded with these symbols.
FUNCTION Entry()
PRINT ToRoman$(1990) ' MCMXC
PRINT ToRoman$(2018) ' MMXVIII
PRINT ToRoman$(3888) ' MMMDCCCLXXXVIII
END FUNCTION
FUNCTION ToRoman$(aValue%%)
DIM weights%%[12]
DIM symbols$[12]
weights%%[0] = 1000
weights%%[1] = 900
weights%%[2] = 500
weights%%[3] = 400
weights%%[4] = 100
weights%%[5] = 90
weights%%[6] = 50
weights%%[7] = 40
weights%%[8] = 10
weights%%[9] = 9
weights%%[10] = 5
weights%%[11] = 4
weights%%[12] = 1
symbols$[0] = "M"
symbols$[1] = "CM"
symbols$[2] = "D"
symbols$[3] = "CD"
symbols$[4] = "C"
symbols$[5] = "XC"
symbols$[6] = "L"
symbols$[7] = "XL"
symbols$[8] = "X"
symbols$[9] = "IX"
symbols$[10] = "V"
symbols$[11] = "IV"
symbols$[12] = "I"
destination$ = ""
i@@ = 0
DO WHILE (i@@ <= 12) AND (aValue%% > 0)
DO WHILE aValue%% >= weights%%[i@@]
destination$ = destination$ + symbols$[i@@]
aValue%% = aValue%% - weights%%[i@@]
LOOP
i@@ = i@@ + 1
LOOP
RETURN destination$
END FUNCTION
END PROGRAM