Rebol [
   file: %base-convert.r
   title: "Base conversion functions"
   author: "Sunanda"
   date: 01-sep-2005
   version: 0.0.2
   purpose: {Functions to convert an decimal whole number to and from any arbitrary base}
   library: [
           level: 'intermediate
        platform: [all plugin]
            type: [tool function]
          domain: [math scientific financial]
    tested-under: [win]
         support: none
         license: 'GPL
        see-also: none
          plugin: [size: 770x140]
     ]
   history: [
             0.0.1 1-aug-2004 {Written}
             0.0.2 1-sep-2005 {Added View/browser plugin front end}
            ]
    ]


;; ---------------------------------------------------------------------
;; This script has two objects:
;;
;; base-convert      -- REBOL/Core script that provides conversions
;; view-base-convert -- REBOL/View, REBOL/Plugin front end to play with
;;
;; If you just want to use the base-convert functions, comment
;; out the view-base-convert/run line at the very end
;; -------------------------------------------------------------------

;; --------------
;; Documentation:
;; --------------
;; see http://www.rebol.org/cgi-bin/cgiwrap/rebol/documentation.r?script=base-convert.r


;; ===================
;; base-convert object
;; ===================


base-convert: make object! [

;;  Customisable data items
;;  -----------------------
    maximum-decimal: 999999999
    default-digits: "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    case-sensitive: false
    error-messages: [
        "Maximum base should be "
        "Base minimum is 2. Not "
        "Base contains duplicate characters: "
        "Number to convert must be 0 or greater"
        "Number has unrecognised digit: "
        "Number larger than "
        "Number should be a whole number (no decimal places)"
    ]

;;  ================
;;  to-base function
;;  ================

    to-base: func [number-in [number!]
        to-base [integer! string!]
        /local
         number-out
         int-part
         frac-part
    ][
        if number-in < 0 [make error! error-messages/4]  ;; too small
        if 0 <> (number-in // 1)  [make error! error-messages/7] ;; not whole number
        if number-in > maximum-decimal [make error! join error-messages/6 maximum-decimal] ;; too big
        to-base: make-base-string to-base
        number-out: copy ""
        int-part: number-in
        until
        [
            frac-part: 1 + (int-part // length? to-base)
            if frac-part > length? to-base [frac-part: 1]
            insert number-out to-base/:frac-part
            int-part: to-integer (int-part / length? to-base)
            int-part = 0
        ]
        return number-out
    ] ;; func

;;  ==================
;;  from-base function
;;  ==================
    from-base: func [number-in [string!]
        from-base [integer! string!]
        /local
         number-out
         curr-digit
    ][
        from-base: make-base-string from-base
        number-out: 0.0
        foreach digit number-in
        [   number-out: number-out * length? from-base
            either case-sensitive
            [curr-digit: find/case from-base to-string digit]
            [curr-digit: find from-base to-string digit]
            if none? curr-digit [make error! join error-messages/5 to-string digit]  ;; bad digit
            number-out: number-out - 1 + index? curr-digit
        ]
        return number-out
    ] ;; func

;;  ====================================
;;  internal function:  make base string
;;  ====================================
    make-base-string: func [item [integer! string!]
    ][
        if integer? item
        [
            if item > length? default-digits
            [make error! join error-messages/1 length? default-digits] ;; base too large
            item: copy/part default-digits item
        ]
        if not case-sensitive [uppercase item]
        if 2 > length? item
           [make error! join error-messages/2 length? item]  ;; gotta be at least base-2
        if all [not case-sensitive (length? item) <> length? unique item] ;; duplicate digits
           [make error! join error-messages/3 item]
        if all [case-sensitive (length? item) <> length? unique/case item] ;; duplicate
           [make error! join error-messages/3 item]
        return item
    ] ;; func

;;  =======================================================
;;  function to test drive the conversions -- useful if you
;;  make changes and want to run some verification tests
;;  =======================================================
    test-drive: func [/local tests-count
                             base
                             number
    ][
        tests-count: 0
        forever
        [
            if 0 = (tests-count // 1000)
            [
                print [now/time " Tests completed: " tests-count]
            ]
            tests-count: tests-count + 1

        ;;  Test decimal --> base --> decimal
        ;;  ---------------------------------

            base: maximum 2 random/secure 36
            number: random/secure maximum-decimal
            if number <> result: from-base to-base number base base
            [
                print [tests-count "//1: Failure on base:" base " Number: " number " -- " result]
            ]

        ;;  Test base --> decimal --> base
        ;;  ------------------------------
            base: random/secure copy default-digits
            base: copy/part base maximum 2 random/secure length? base
            number: copy ""

            loop random/secure length? base [append number random/only base]

            loop -1 + length? number   ;; remove leading "zeroes" from number
                [either number/1 = base/1
                    [number: copy skip number 1]
                    [break]
                ]
            result: from-base number base
            if result < maximum-decimal   ;; can't convert back if too large
              [result: to-base result base
                if result <> number
                [
                    print [tests-count "//2: Failure on base:" base " Number: " number " -- " result]
                ]
              ]
        ] ;; forever
    ] ;; func
] ;; object







;; ========================
;; view-base-convert object
;; ========================

view-base-convert: make object!
[

  ;; Data variables for layout
  ;; -------------------------

  from-base:
    to-base:
     number:
     result: none

run: func [
  /local
][
 unview/all
 view/new xx: layout
  [
   across
   banner "Convert between bases"
   return
   from-base: rotary  "xx"
            [view-base-convert/convert]
   number: field 250 bold white font-color blue
            [view-base-convert/convert]
   return
   to-base: rotary    "xx"
            [view-base-convert/convert]

   result: info 250 bold blue font-color white
   return
   button "convert!" [view-base-convert/convert]
  ]

  ;; Set rotaries
  ;; ------------

  from-base/data: copy []
    to-base/data: copy []
  for nn 2 36 1
     [
      append from-base/data join "from " nn
      append   to-base/data join "to " nn
     ]
  from-base/data: skip from-base/data 8    ;; base 10
    to-base/data: skip to-base/data 14     ;; base 16
  show from-base
  show to-base


  ;; Fire it up
  ;; ----------

   do-events


   return true
]

;; =====================================================

convert: func [
  /local
   b-from
   b-to
   base10-value
   baseN-value
   oops
][

;; ---------------------------------------------
;; We could do this a bit faster by checking
;; if either of the bases is 10, but let's not!
;; ----------------------------------------------


error? oops: try
   [
    b-from: to-integer skip from-base/text 5
    b-to:   to-integer skip to-base/text 3

    base10-value: base-convert/from-base number/text b-from
    baseN-value: base-convert/to-base base10-value b-to
    result/text: baseN-value
    show result
    return true
   ]

;; Oops -- something has gone wrong
;; --------------------------------

oops: disarm oops
result/text:  oops/arg1
show result
return true

]


] ;; object


;; ===============================
;; Start the View/Plugin front end
;; ===============================

view-base-convert/run