%%HP: T(3)A(R)F(.);
\<<
  IF { 0. 28. } OVER TYPE POS	@	pos	value
  THEN				@ je to cislo
    DUP I\->R IP DUP			@	ipval	ipval	value
    1. < SWAP 3999. > OR	@	0./.1	value
    SWAP 0. ROT			@	0./.1	type	value
  ELSE
    DUP TYPE			@	type	value
    CASE
      DUP 2. ==			@ je to retezec
      THEN
      END
      DUP 6. ==			@ je to algebraicky vyraz
      THEN			@ bude preveden na retezec
        SWAP \->STR DUP SIZE 1. - 2. SWAP SUB SWAP
      END
      DROP			@	value
      \->STR "Bad Argument: " SWAP + DOERR
    END
    OVER SIZE DUP		@	size	size	type	value
    1. < SWAP 15. > OR		@	0./.1	type	value
  END
  IF
  THEN
    DROP			@	value
    "Bad Range: " SWAP \->STR + DOERR
  END
  "IVXLCDM"			@	sromt	type	value
  \-> sromt
  \<<
    IF				@	type	value
    THEN			@	value
      0.			@	less	value
      sromt SIZE		@	pidx	less	value
      {0. 0. 0. 0.} DUP		@	subt	addt	pidx	less	value
      \<< \<-pidx 1. - 2. / IP 1. + \>>
      \-> \<-pidx addt subt \->ord
      \<<
        DO			@	less	value
          OVER HEAD sromt SWAP	@	digit	sromt	less	value
          POS			@	aidx	less	value
          IF DUP NOT
          THEN			@	aidx	less	value
            DROP2 "Unknown Digit: " SWAP + DOERR
          END
          SWAP OVER \<-pidx	@	pidx	aidx	less	aidx	value
          IF <
          THEN			@ if(aidx < pid)
            DROP 0.		@   less = 0;
          ELSE			@ else
            1. +		@   ++less;
          END
          CASE			@	less	aidx	value
            DUP 3. >
            THEN
              DROP2		@	value
            END
            OVER \<-pidx \<=
            THEN
            END			@	less	aidx	value
            DUP 1. \<=
            THEN
              'addt'		@	'addt'	less	aidx	value
              \->ord EVAL 	@	_ORD()	'addt'	less	aidx	value
              DUP2		@	_ORD()	'addt'	_ORD()	'addt'	less	aidx	value
              GET		@	addt[]	_ORD()	'addt'	less	aidx	value
              OVER		@	_ORD()	addt[]	_ORD()	'addt'	less	aidx	value
              'subt' SWAP ROT 	@	addt[]	_ORD()	'subt'	_ORD()	'addt'	less	aidx	value
              PUT		@	_ORD()	'addt'	less	aidx	value
              0.		@	0.	_ORD()	'addt'	less	aidx	value
              PUT		@	less	aidx	value
            END
            DROP2		@	value
          END
          IF DUP TYPE		@ typ neni Real ale String
          THEN
            "Unexpected Digit: " SWAP + DOERR
          END
          SWAP '\<-pidx'		@	'pidx'	aidx	less	value
          STO			@ pidx = aidx;
          'addt' \->ord EVAL	@	_ORD()	'addt'	less	value
          DUP2			@	_ORD()	'addt'	_ORD()	'addt'	less	value
          GET			@	addt[]	_ORD()	'addt'	less	value
 \<-pidx 1. - 2. / FP 8. * 1. +	@	_INC()	addt[]	_ORD()	'addt'	less	value
          +			@	addt[]	_ORD()	'addt'	less	value
          DUP 4. ROLLD		@	addt[]	_ORD()	'addt'	addt[]	less	value
          PUT			@	addt[]	less	value
          IF 9. >
          THEN
            DROP
            "Too much Digits: " SWAP + DOERR
          END
        UNTIL
          SWAP TAIL SWAP	@	less	value
          OVER SIZE		@	size	less	value
          NOT
        END
        DROP2 addt subt		@	subt	addt
      \>>
      -				@	{ }
      1.			@	1.	{ }
      \<< NSUB 1. - ALOG * \>>	@	\<< \>>	1.	{ }
      DOSUBS			@	{ }
      \GSLIST R\->I		@	result
    ELSE
      I\->R IP			@	value
      ""			@	result	value
      DO
        SWAP DUP LOG IP		@ order: dekadicky rad aktualni cifry
        DUP			@	order	order	value	result
        ALOG			@ divisor: delitel pro ziskani nejvyssi cifry
        ROT			@	value	divisor	order	result
        DUP PICK3		@	divisor	value	value	divisor	order	result
        / IP			@ digit: aktualni cifra
        ROT			@	divisor	digit	value	order	result
        OVER *			@ aktualni cifra na puvodnim radu
        NEG			@	-d000	digit	value	order	result
        ROT			@	value	-d000	digit	order	result
        +			@	value	digit	order	result
        4. ROLLD SWAP		@	order	digit	result	value
        2. * 1. +		@ sidx:  index do sromt
        { 4. 9. }		@	{4 9}	sidx	digit	result	value
        PICK3			@	digit	{4 9}	sidx	digit	result	value
        IF POS			@	0./1.	sidx	digit	result	value
        THEN			@ je to 4 nebo 9
          sromt			@	sromt	sidx	digit	result	value
          OVER DUP		@	sidx	sidx	sromt	sidx	digit	result	value
          SUB			@	sromt[]	sidx	digit	result	value
          UNROT 1. +		@	sidx	digit	sromt[]	result	value
          SWAP			@	digit	sidx	sromt[]	result	value
          9. ==			@	0./1.	sidx	sromt[]	result	value
          +			@	sidx	sromt[]	result	value
          UNROT			@	sromt[]	result	sidx	value
          +			@	result	sidx	value
          sromt			@	sromt	result	sidx	value
          ROT DUP		@	sidx	sidx	sromt	result	value
          SUB			@	sromt[]	result	value
          +			@	result	value
        ELSE			@ neco jineho nez 4 nebo 9
          UNROT			@	digit	result	sidx	value
          WHILE DUP
          REPEAT
            PICK3		@	idx	digit	result	sidx	value
            IF OVER 5. \>=
            THEN
              1. + SWAP		@	digit	idx+1	result	sidx	value
              4. - SWAP		@	idx+1	digit-4	result	sidx	value
            END
            sromt OVER ROT	@	idx	idx	sromt	digit	result	sidx	value
            SUB			@	sromt[]	digit	result	sidx	value
            ROT SWAP		@	sromt[]	result	digit	sidx	value
            + SWAP 1. -		@	digit-1	result	sidx	value
          END
          ROT			@	sidx	digit-1	result	value
          DROP2			@	result	value
        END
      UNTIL
        OVER NOT		@	0./1.	result	value
      END
      NIP			@	result
    END
  \>>
\>>