Data commit

Task/Roman-numerals-Decode/FreeBASIC/roman-numerals-decode.basic

@@ -0,0 +1,62 @@
+' FB 1.05.0 Win64
+
+Function romanDecode(roman As Const String) As Integer
+  If roman = "" Then Return 0  '' zero denotes invalid roman number
+  Dim roman1(0 To 2) As String = {"MMM", "MM", "M"}
+  Dim roman2(0 To 8) As String = {"CM", "DCCC", "DCC", "DC", "D", "CD", "CCC", "CC", "C"}
+  Dim roman3(0 To 8) As String = {"XC", "LXXX", "LXX", "LX", "L", "XL", "XXX", "XX", "X"}
+  Dim roman4(0 To 8) As String = {"IX", "VIII", "VII", "VI", "V", "IV", "III", "II", "I"}
+  Dim As Integer i, value = 0, length = 0
+  Dim r As String = UCase(roman)
+
+  For i = 0 To 2
+    If Left(r, Len(roman1(i))) = roman1(i) Then
+      value += 1000 * (3 - i)
+      length = Len(roman1(i))
+      r = Mid(r, length + 1)
+      length = 0
+      Exit For
+    End If
+  Next
+
+  For i = 0 To 8
+    If Left(r, Len(roman2(i))) = roman2(i) Then
+      value += 100 * (9 - i)
+      length = Len(roman2(i))
+      r = Mid(r, length + 1)
+      length = 0
+      Exit For
+    End If
+  Next
+
+  For i = 0 To 8
+    If Left(r, Len(roman3(i))) = roman3(i) Then
+      value += 10 * (9 - i)
+      length = Len(roman3(i))
+      r = Mid(r, length + 1)
+      length = 0
+      Exit For
+    End If
+  Next
+
+  For i = 0 To 8
+    If Left(r, Len(roman4(i))) = roman4(i) Then
+      value += 9 - i
+      length = Len(roman4(i))
+      Exit For
+    End If
+  Next
+
+  ' Can't be a valid roman number if there are any characters left
+  If Len(r) > length Then Return 0
+  Return value
+End Function
+
+Dim a(2) As String = {"MCMXC", "MMVIII" , "MDCLXVI"}
+For i As Integer = 0 To 2
+  Print a(i); Tab(8); " =>"; romanDecode(a(i))
+Next
+
+Print
+Print "Press any key to quit"
+Sleep