proc base_characters {base_n} {
set base [list 0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M \
N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p \
q r s t u v w x y z]
if {$base_n < 2 || $base_n > 62} {
error "Invalid base \"$base_n\" (should be an integer between 2 and 62)"
}
return [lrange $base 0 [expr $base_n - 1]]
}
proc base_n_to_decimal {number base_n} {
set base [base_characters $base_n]
# trim white space in case [format] is used
set number [string trim $number]
# bases 11 through 36 can be treated in a case-insensitive fashion
if {$base_n <= 36} {
set number [string toupper $number]
}
set decimal 0
set power [string length $number]
foreach char [split $number ""] {
incr power -1
set dec_val [lsearch $base $char]
if {$dec_val == -1} {
error "$number is not a valid base $base_n number"
}
set decimal [expr $decimal + $dec_val * int(pow($base_n,$power))]
}
return $decimal
}
proc decimal_to_base_n {number base_n} {
set base [base_characters $base_n]
# trim white space in case [format] is used
set number [string trim $number]
if {![string is integer $number] || $number < 0} {
error "$number is not a base-10 integer between 0 and 2147483647"
}
while 1 {
set quotient [expr $number / $base_n]
set remainder [expr $number % $base_n]
lappend remainders $remainder
set number $quotient
if {$quotient == 0} {
break
}
}
set base_n [list]
for {set i [expr [llength $remainders] - 1]} {$i >= 0} {incr i -1} {
lappend base_n [lindex $base [lindex $remainders $i]]
}
return [join $base_n ""]
}
proc convert_number {number "from" "base" base_from "to" "base" base_to} {
return [decimal_to_base_n [base_n_to_decimal $number $base_from] $base_to]
}[Bryan Steimel] - same thing as above for the most part, just what I managed to put together .. hopefully its helpful to someone. usage is hopefully self explanatory .. [to_base <num> <base>] and vice versa
variable base_chars "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
proc to_base {number base} {
variable base_chars
if {$number==0} {
return 0
} elseif {(($base>62) || ($base<2))} {
return -code error "base: expected integer between 2 and 62, got '$base'"
}
set nums [string range $base_chars 0 [expr $base - 1]]
set result ""
while {$number > 0} {
set result "[string index $nums [expr $number % $base]]${result}"
set number [expr int($number / $base)]
}
set result
}
proc from_base {number base} {
variable base_chars
if {(($base>62) || ($base<2))} {
return -code error "base: expected integer between 2 and 62, got '$base'"
}
set nums [string range $base_chars 0 [expr $base - 1]]
for {
set result 0
set i 0
set len [string length $number]
} {$i<$len} {
incr i
} { incr i
set result [expr $result * $base]
set result [expr $result + [string first [string index $number $i] $nums]]
}
set result
} LV I'm searching for a technique of transforming strings. The transformation is to take a string like "Abc" and transforming it into an ASCII string of base 2, and then code to do the reverse - to transform "0110000101101001" and so forth into a string of alphabetic (or whatever) characters. However, I don't know how clear that description is... Anyways, I'm trying to figure out exactly how to do this - do I need to use the above code along with binary, format and scan to accomplish what I'm aiming for?
[FrankBannon] - 2011-11-09 22:29:51LV: you have helped me so many times I feel compelled to return the favor. One quick method to convert text to binary and back might be:
# text to binary
proc text_to_bin str {
foreach s [split $str ""] {
set dec [scan $s %c]
set bin [decimal_to_base_n $dec 2]
append output [format "%08s " $bin] ;# pad to 8 bits
}
return $output
}
# binary to text
proc bin_to_text str {
foreach s $str {
append output [format "%c" [scan $s %b]]
}
return $output
}
set binary [text_to_bin Tickle]
01010100 01101001 01100011 01101011 01101100 01100101
bin_to_text $binary
Tickle