(49G) Roman representation of an integer per OEIS A061493

[Gerald H]

The programme converts integer input into the Roman representation using the substitutions

1 for I
2 for V
3 for X
4 for L
5 for C
6 for D
7 for M

eg For input

1953

the programme returns

7574111

For the first time in a computing programme for Roman representation zero is recognised! & portrayed by "NULLA".

For the first time negative numbers are acknowledged & the quality preserved in the output!

(These two probably unnecessary innovations can easily be excised from the programme, we Romans just don't want to be considered stick in the muds.)

For further info see:

http://oeis.org/A061493

Code:


::
  CK1&Dispatch
  BINT1
  ::
    DUP%0=
    casedrop
    "NULLA"
    DUP
    %0>
    SWAP
    %ABSCOERCE
    NULL$
    BEGIN
    OVER
    # 3E8
    #>=_
    WHILE
    ::
      SWAP
      # 3E8
      #-SWAP
      CHR_7
      >T$
    ;
    REPEAT
    OVER
    # 384
    ::
      #>=_
      case
      ::
        SWAP
        # 384
        #-SWAP
        "57"
        &$
      ;
      OVER
      # 1F4
      #>=_
      IT
      ::
        SWAP
        # 1F4
        #-SWAP
        CHR_6
        >T$
      ;
      OVER
      # 190
      #>=_
      case
      ::
        SWAP
        # 190
        #-SWAP
        "56"
        &$
      ;
      BEGIN
      OVER
      BINT100
      #>=_
      WHILE
      ::
        SWAP
        BINT100
        #-SWAP
        CHR_5
        >T$
      ;
      REPEAT
    ;
    OVER
    BINT90
    ::
      #>=_
      case
      ::
        SWAP
        BINT90
        #-SWAP
        "35"
        &$
      ;
      OVER
      BINT50
      #>=_
      IT
      ::
        SWAP
        BINT50
        #-SWAP
        CHR_4
        >T$
      ;
      OVER
      BINT40
      #>=_
      case
      ::
        SWAP
        BINT40
        #-SWAP
        "34"
        &$
      ;
      BEGIN
      OVER
      BINT10
      #>=_
      WHILE
      ::
        SWAP
        BINT10
        #-SWAP
        CHR_3
        >T$
      ;
      REPEAT
    ;
    OVER
    BINT9
    ::
      #=case
      ::
        "13"
        &$
      ;
      OVER
      BINT5
      #>=_
      IT
      ::
        SWAP
        BINT5
        #-SWAP
        CHR_2
        >T$
      ;
      OVER
      BINT4
      #=case
      ::
        "12"
        &$
      ;
      BEGIN
      OVER
      BINT1
      #>=_
      WHILE
      ::
        SWAP#1-SWAP
        CHR_1
        >T$
      ;
      REPEAT
    ;
    SWAPDROPSWAP
    ?SKIP
    ::
      CHR_-
      >H$
    ;
    FPTR2 ^S>Z
  ;
;