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 }