1# util-number.tcl --
2#
3#	This file implements package ::Utility::number, which  ...
4#
5# Copyright (c) 1997 Jeffrey Hobbs
6#
7# See the file "license.terms" for information on usage and
8# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
9#
10
11#package require NAME VERSION
12package provide ::Utility::number 1.0
13
14namespace eval ::Utility::number {;
15
16namespace export -clear *
17
18# get_square_size --
19#   gets the minimum square size for an input
20# Arguments:
21#   num		number
22# Returns:
23#   returns smallest square size that would fit number
24#
25;proc get_square_size num {
26    set i 1
27    while {[expr {$i*$i}] < $num} { incr i }
28    return $i
29}
30
31# roman2dec --
32#   converts a roman numeral to decimal
33# Arguments:
34#   x		number in roman numeral format
35# Returns:
36#   decimal number
37#
38;proc roman2dec {x} {
39    set result ""
40    foreach elem {
41	{ 1000	m }	{ 900	cm }
42	{ 500	d }	{ 400	id }
43	{ 100	c }	{ 90	ic }
44	{ 50	l }
45	{ 10	x }	{ 9	ix }
46	{ 5	v }	{ 4	iv }
47	{ 1	i }
48    } {
49	set digit [lindex $elem 0]
50	set roman [lindex $elem 1]
51	while {$x >= $digit} {
52	    append result $roman
53	    incr x -$digit
54	}
55    }
56    return $result
57}
58
59# bin2hex --
60#   converts binary to hex number
61# Arguments:
62#   bin		number in binary format
63# Returns:
64#   hexadecimal number
65#
66;proc bin2hex bin {
67    ## No sanity checking is done
68    array set t {
69	0000 0 0001 1 0010 2 0011 3 0100 4
70	0101 5 0110 6 0111 7 1000 8 1001 9
71	1010 a 1011 b 1100 c 1101 d 1110 e 1111 f
72    }
73    set diff [expr {4-[string length $bin]%4}]
74    if {$diff != 4} {
75        set bin [format %0${diff}d$bin 0]
76    }
77    regsub -all .... $bin {$t(&)} hex
78    return [subst $hex]
79}
80
81
82# hex2bin --
83#   converts hex number to bin
84# Arguments:
85#   hex		number in hex format
86# Returns:
87#   binary number (in chars, not binary format)
88#
89;proc hex2bin hex {
90    array set t {
91	0 0000 1 0001 2 0010 3 0011 4 0100
92	5 0101 6 0110 7 0111 8 1000 9 1001
93	a 1010 b 1011 c 1100 d 1101 e 1110 f 1111
94	A 1010 B 1011 C 1100 D 1101 E 1110 F 1111
95    }
96    regsub {^0[xX]} $hex {} hex
97    regsub -all . $hex {$t(&)} bin
98    return [subst $bin]
99}
100
101}
102