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
}