%%HP: T(3)A(R)F(.);
@ BASECALC by Ian Matthew Smith
@ Automatic decimal lengths added by Joe Horn
DIR
  BMTH @ create custom menu
    \<< { Add \<< IB2\-> + \->IB \>> }
        { Sub \<< IB2\-> - \->IB \>> }
        { Mul \<< IB2\-> * \->IB \>> }
        { Div \<< IB2\-> / \->IB \>> }
      BBASE "/" IBFIX + +
      { \<< B\->FIX 'BBASE' STO BMTH \>>
        \<< B\->FIX SWAP IB\-> SWAP 'BBASE' STO \->IB BMTH \>>
        \<< 'IBFIX' STO BMTH \>> }
      2 \->LIST { CONV {
      \<< DUP
        IF TYPE 2 ==
        THEN IB\->
        ELSE \->IB
        END
      \>>
      \<< DUP
        IF TYPE 0 ==
        THEN R\->B
        ELSE DUP
          IF TYPE 10 ==
          THEN B\->R
          END
        END
      \>> } } 6 \->LIST TMENU
    \>>
  \->IB
    \<< DUP
      IF TYPE 0 ==
      THEN DUP FP SWAP IP R\->B
      ELSE 0 SWAP
      END DUP
      IF TYPE 10 ==
      THEN RCWS SWAP "" SWAP 64 STWS
        WHILE DUP B\->R
        REPEAT DUP BBASE DUP2 / * - 1 + BSTR SWAP
          B\->R DUP SUB ROT + SWAP BBASE /
        END DROP SWAP STWS SWAP
        IF DUP BBASE IBFIX ^ * 1 <
        THEN DROP
        ELSE "" SWAP 1 IBFIX
          START
            IF DUP 0 \=/
            THEN BBASE * DUP IP BSTR SWAP 1 + DUP SUB ROT SWAP + SWAP FP
            END
          NEXT DROP "." SWAP + +
        END
      END
    \>>
  IB\->
    \<< DUP
      IF TYPE 2 ==
      THEN RCWS SWAP 64 STWS
        IF DUP "." POS
        THEN DUP DUP "." POS SWAP DUP SIZE ROT 1 + SWAP SUB
          SWAP DUP "." POS 1 - 1 SWAP SUB
        ELSE "" SWAP
        END # 0d SWAP DUP SIZE 1 - 0 SWAP
        FOR j DUP DUP SIZE j - DUP SUB BSTR SWAP POS 1 - # 1d
          IF j 0 >
          THEN BBASE 1 j
            START DUP ROT * SWAP
            NEXT DROP
          END * ROT + SWAP
        NEXT DROP
        IF DUP B\->R 1.E12 < IBFIX AND
        THEN B\->R
        END SWAP
        IF DUP SIZE
        THEN 0 SWAP DUP SIZE 1 SWAP
          FOR j DUP j j SUB BSTR SWAP POS 1 - BBASE j NEG ^ * ROT + SWAP
          NEXT DROP +
        ELSE DROP
        END SWAP STWS
      ELSE
        IF DUP TYPE 0 == IBFIX NOT AND
        THEN R\->B
        END
      END
    \>>
  IB2\->
    \<< IB\-> SWAP IB\-> SWAP
    \>>
  BBASE 16
  IBFIX 0
  \->IB2
    \<< \->IB SWAP \->IB SWAP
    \>>
  B\->FIX  @ this tiny routine was tacked on by Joe Horn
    \<< 2 MAX 62 MIN 12 OVER LOG / IP 'IBFIX' STO
    \>>
  BSTR
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
END