Romans

 

Давно собирался переписать конвертер, сделанный на Ассемблере, и провел инспекцию на Rosetta Stone. Скачать.

Оставлю старые куски исходников

Число в римские

#SymbolCount = 12 ;0 based count
DataSection
  denominations:
  Data.s "M","CM","D","CD","C","XC","L","XL","X","IX","V","IV","I" ;0-12
 
  denomValues:
  Data.i  1000,900,500,400,100,90,50,40,10,9,5,4,1 ;values in decending sequential order
EndDataSection
 
;-setup
Structure romanNumeral
  symbol.s 
  value.i
EndStructure
 
Global Dim refRomanNum.romanNumeral(#SymbolCount)
 
Restore denominations
For i = 0 To #SymbolCount
  Read.s refRomanNum(i)\symbol
Next
 
Restore denomValues
For i = 0 To #SymbolCount
  Read refRomanNum(i)\value
Next  
 
Procedure.s decRoman(n)
  ;converts a decimal number to a roman numeral
  Protected roman$, i
 
  For i = 0 To #SymbolCount
    While n >=refRomanNum(i)\value;Repeat
        roman$ + refRomanNum(i)\symbol
        n - refRomanNum(i)\value
Wend
;       If n >= refRomanNum(i)\value
;         roman$ + refRomanNum(i)\symbol
;         n - refRomanNum(i)\value
;       Else
;         Break
;       EndIf
;     ForEver
  Next
 
  ProcedureReturn roman$
EndProcedure
 
If OpenConsole()
 
  PrintN(decRoman(1999)) ;MCMXCIX
  PrintN(decRoman(1666)) ;MDCLXVI
  PrintN(decRoman(25))   ;XXV
  PrintN(decRoman(954))  ;CMLIV
;  PrintN(decRoman(4000))  ;CMLIV
 
  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
  Input()
  CloseConsole()
EndIf

Римские в числа

Procedure romanDec(roman.s)
  Protected i, n, lastval, arabic
  
  ;Debug lastval
  For i = Len(roman) To 1 Step -1
    Select UCase(Mid(roman, i, 1))
      Case "M"
        n = 1000
      Case "D"
        n = 500
      Case "C"
        n = 100
      Case "L"
        n = 50
      Case "X"
        n = 10
      Case "V"
        n = 5
      Case "I"
        n = 1
      Default
        n = 0
    EndSelect
    If (n < lastval)
      arabic - n
    Else
      arabic + n
    EndIf
    lastval = n
  Next 
 
  ProcedureReturn arabic
EndProcedure
 
If OpenConsole()
  PrintN(Str(romanDec("MCMXCIX"))) ;1999
  PrintN(Str(romanDec("MDCLXVI"))) ;1666
  PrintN(Str(romanDec("XXV")))     ;25
  PrintN(Str(romanDec("CMLIV")))   ;954
  PrintN(Str(romanDec("MMXI")))    ;2011
 
  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf