Welcome, guest | Sign In | My Account | Store | Cart
proc toRoman {arabic} {
 
#September 2001 by George M Jempty: jb4mt@webfielding.com
 
 
if {![string is integer -strict $arabic] || $arabic < 1 || $arabic > 3999} {
   
return -code error "Please retry with an integer from 1 to 3999"
 
}
 
 
set numerals [list I V X L C D M]
 
set index 0
 
set roman ""
 
 
while {$arabic} {
   
set digit [expr {$arabic%10}]
   
set arabic [expr {$arabic/10}]
   
set place ""

   
if {$digit == 4 || $digit == 9} {
     
set place [lindex $numerals [expr {$digit/4 + $index}]]
     
set place [lindex $numerals $index]$place
   
} else {
     
for {set pad 0} {$pad < [expr {$digit%5}]} {incr pad} {
       
set place [lindex $numerals $index]$place
     
}
     
if {$digit >= 5} {
       
set place [lindex $numerals [expr {$index+1}]]$place
     
}
   
}
    incr index
2
   
set roman $place$roman
 
}  
 
return $roman
}

History

  • revision 5 (22 years ago)
  • previous revisions are not available