rem Roman Numeral Conversion rem Made by Sinani201 rem The DB Classic Programming Challenge Thread rem Make an array to define the Roman digits REM CHANGE THIS TO YOUR SCREEN RESOLUTION set display mode 1440,900,32 rem Set this to 0 if the debug info is longer than your screen. debug = 1 cls rem Make an array to hold the Roman digits, name it Roman Library (rlib) dim rlib$(4,3) rlib$(1,1) = "I" : rlib$(1,2) = "V" : rlib$(1,3) = "X" rlib$(2,1) = "X" : rlib$(2,2) = "L" : rlib$(2,3) = "C" rlib$(3,1) = "C" : rlib$(3,2) = "D" : rlib$(3,3) = "M" rlib$(4,1) = "M" : rem The program will not allow higher values. rem Make an array to define the Arabic equivalent of the Roman digits, name it Arabic Library (alib) dim alib(4,3) alib(1,1) = 1 : alib(1,2) = 5 : alib(1,3) = 10 alib(2,1) = 10 : alib(2,2) = 50 : alib(2,3) = 100 alib(3,1) = 100 : alib(3,2) = 500 : alib(3,3) = 1000 alib(4,1) = 1000: rem The program will not allow higher values. do input "Give me a Roman or Arabic number and I will convert it: ",a$ ab$=a$ if val(a$) = 0 then gosub r2a else gosub a2r printc " (Press any key to restart)" wait key rem Reset everything rlib$(1,0) = "" : rlib$(2,0) = "" rlib$(3,0) = "" : rlib$(4,0) = "" output=0 cls loop r2a: a$ = upper$(a$) ab$ = a$ print "I got " + a$ + " as your input." workload = len(a$) rem Process each digit individually. for test = 1 to 4 p$ = right$(a$,1) print "Current value is " + a$ + ". Each process will cut off one or two digits depending on the number. Pointing at " + p$ + "." one$ = rlib$(test,1) five$ = rlib$(test,2) ten$ = rlib$(test,3) before$ = charBefore$(a$) print "Checking to see if " + p$ + " is " + rlib$(test,1)+", "+rlib$(test,2)+", or "+rlib$(test,3) select p$ case one$ inc output, alib(test,1) cutOff = 1 : redo = 1 print p$ + " is equal to " + str$(alib(test,1)) + ". This place will be tested again in case " + rlib$(test,1) + " is repeated (e.g., III). " + str$(alib(test,1)) + " has been added to the output." endcase case five$ print p$ + " is equal to " + str$(alib(test,2)) + ". Checking to see if there is a number of less rank behind it." rem Check if the number before is 1 if one$ = before$ print rlib$(test,1) + " is before " + p$ + ". Adding " + str$(alib(test,2) - alib(test,1)) + " to the output." inc output, alib(test,2) - alib(test,1) cutOff = 2 else print "Nothing is before " + rlib$(test,2) + ". Adding " + str$(alib(test,2)) + " to the output." inc output, alib(test,2) cutOff = 1 endif endcase case ten$ print p$ + " is equal to " + str$(alib(test,3)) + ". Checking to see if there is a number of less rank behind it." rem Check if the number before is 1 if before$ = one$ print "OK, there is. Adding " + str$(alib(test,3)-alib(test,1)) + " to the output." inc output, alib(test,3) - alib(test,1) cutOff = 2 else print "OK, there isn't. I wont do anything because the next test will be able to catch the number itself and then add it to the output." endif endcase endselect print "Finished this test. Current output is " + str$(output) + ". Cutting out " + str$(cutOff) + " from the number." if cutOff = len(a$) then exit rem Cut off numbers if necessary if cutOff <> 0 a$ = left$(a$,len(a$)-cutOff) endif if redo = 1 then dec test cutOff = 0 redo = 0 next test if debug = 0 cls print "Input was " + ab$ endif print "FINAL RESULT: " + str$(output) return a2r: a = val(a$) rem Check if the input is bad if a > 3999 print "Too high!" wait key end endif if a < 1 print "Too low!" wait key end endif rem Convert the number to a string for easy parsing. a$ = str$(a) print "String version is " + a$ rem Get the amount of digits so we can tell how many time the program needs to work workload = len(a$) print "There are " + str$(workload) + " digits in your number" for i = 1 to workload rem Use a seperate value to represent individual digits. p$ = right$(a$,1) : p = val(p$) print "Working on current digit: " + str$(p) rem Work! work(rlib$(i,1),rlib$(i,2),rlib$(i,3),i,p) rem Make the input smaller so that p will point to the next digit a$ = left$(a$,workload - i) next i rem Add up all of the values and display it finalresult$ = rlib$(4,0) + rlib$(3,0) + rlib$(2,0) + rlib$(1,0) if debug = 0 cls print "Input was " + ab$ endif print "FINAL RESULT: " + finalresult$ return function charBefore$(full$) output$ = left$(right$(full$,2),1) endfunction output$ function addamount(letter$,place,value) rem Simple check to make sure the number is OK for crunching if value < 4 print "Input for addamount is less than 4, proceeding" rem Loop to add more letters for higher numbers print "Adding " + letter$ + str$(value) + "times" for i=1 to value rlib$(place,0) = rlib$(place,0) + letter$ next i endif endfunction function work(one$,five$,ten$,place,value) rem Skip this workload if there is nothing to do if value = 0 then exitfunction rem We can use this without checking its value, because the value gets checked anyways in addamount addamount(one$,place,value) rem Fill in the irregular numbers (from the Roman point of view) if value = 4 then rlib$(place,0) = one$ + five$ if value = 9 then rlib$(place,0) = one$ + ten$ rem If the number is 5 or higher, make it easy for addamount to crunch the numbers if value > 4 and value < 9 print "Value is greater than 4, proceeding to alternate method" rlib$(place,0) = five$ print "Used character: " + five$ + " for this digit, adding more if necessary" newvalue = value - 5 print "Using " + str$(newvalue) + " for input into addamount" addamount(one$,place,newvalue) endif print "I got " + rlib$(place,0) + " for this digit." endfunction